[m-rev.] for review: --trace-table-io-require
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri Jul 19 15:50:55 AEST 2002
For anyone to review. Although the diff is long, most of it is pretty simple,
consisting of a systematic addition of annotations to foreign_procs.
Zoltan.
Estimated hours taken: 12
Branches: main
Until now, programmers could add `tabled_for_io' annotations to foreign_procs
that do I/O, which asks the compiler to make those foreign_procs idempotent,
i.e. ensures that they are performed at most once even in the presence of a
retry operation in the debugger. This change adds a compiler option,
--trace-table-io-require, which generates an error if a foreign_proc that does
I/O does not have this annotation. Specifying this option thus ensures
that all I/O done by the program is idempotent.
In the future, we may want to have this option turned on in all debugging
grades. Until we decide about, the new option is not yet documented.
compiler/options.m:
Add the new option --trace-table-io-require.
compiler/handle_options.m:
Make --trace-table-io-require imply --trace-table-io.
compiler/table_gen.m:
If --trace-table-io-require is enabled, require all I/O primitives
to have the tabled_for_io annotation.
compiler/mercury_compile.m:
Pass I/O states to table_gen.m, since it can now generate error
messages.
trace/mercury_trace_util.h:
trace/mercury_trace_vars.c:
When calling Mercury code from the trace directory, disable I/O
tabling, since any I/O actions executed by Mercury code in the browser
directory (or by library code called from there) should not be tabled,
not being part of the user program.
Due to the depth of nesting, make mercury_trace_vars.c use four-space
indentation.
browser/collect_lib.m:
browser/declarative_debugger.m:
browser/declarative_execution.m:
browser/dl.m:
browser/io_action.m:
browser/mdb.m:
browser/name_mangle.m:
browser/util.m:
compiler/gcc.m:
compiler/mercury_compile.m:
compiler/passes_aux.m:
compiler/process_util.m:
compiler/stack_layout.m:
library/io.m:
library/time.m:
tests/debugger/declarative/tabled_read_decl.m:
Add a whole lot of tabled_for_io annotations, to enable the compiler to
bootstrap with --trace-table-io-require enabled.
In many cases, this required turning old-style pragma c_code into
pragma foreign_proc. While doing that, I standardized the layouts
of pragma foreign_procs.
browser/util.m:
Turn an impure semidet predicate into a pure det predicate with I/O
states, to allow it to be tabled. Make it return a Mercury bool
to indicate success or failure.
library/bool.m:
Add functions that allow C code to get their hands on the constants
`yes' and `no', for communication with Mercury code.
library/table_builtin.m:
Add debugging code to the main primitive of I/O tabling. This is
controlled both by the macro for retry debugging and a boolean global.
library/mercury_trace_base.[ch]:
Add the boolean global variable to switch the new debugging code in
table_builtin.m on and off.
library/mercury_trace_internal.c:
When starting I/O tabling with retry debug enabled, turn on the switch.
cvs diff: Diffing .
cvs diff: Diffing bench
cvs diff: Diffing bench/progs
cvs diff: Diffing bench/progs/compress
cvs diff: Diffing bench/progs/icfp2000
cvs diff: Diffing bench/progs/icfp2001
cvs diff: Diffing bench/progs/nuc
cvs diff: Diffing bench/progs/ray
cvs diff: Diffing bench/progs/tree234
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
Index: browser/collect_lib.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/collect_lib.m,v
retrieving revision 1.7
diff -u -b -r1.7 collect_lib.m
--- browser/collect_lib.m 2001/07/05 08:05:31 1.7
+++ browser/collect_lib.m 2002/07/17 03:59:11
@@ -78,11 +78,12 @@
% at each event.
% dynamically link the collect module;
-:- pred link_collect(string, c_pointer, c_pointer, c_pointer, c_pointer, c_pointer,
- dl__result(handle), char, io__state, io__state).
+:- pred link_collect(string, c_pointer, c_pointer, c_pointer, c_pointer,
+ c_pointer, dl__result(handle), char, io__state, io__state).
:- mode link_collect(in, out, out, out, out, out, out, out, di, uo) is det.
-link_collect(ObjectFile, Filter, Initialize, PostProcess, SendResult, GetCollectType,
- MaybeHandle, Result) -->
+
+link_collect(ObjectFile, Filter, Initialize, PostProcess, SendResult,
+ GetCollectType, MaybeHandle, Result) -->
%
% Link in the object code for the module `collect' from ObjectFile.
%
@@ -131,9 +132,9 @@
).
:- pred set_to_null_pointer(c_pointer::out) is det.
-:- pragma c_code(set_to_null_pointer(Pointer::out),
- [will_not_call_mercury, thread_safe],
- "(Pointer = (MR_Word) NULL)").
+:- pragma foreign_proc("C", set_to_null_pointer(Pointer::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"(Pointer = (MR_Word) NULL)").
%------------------------------------------------------------------------------%
@@ -152,11 +153,10 @@
display_close_result(Result)
).
-
:- pred display_close_result(dl__result, io__state, io__state).
:- mode display_close_result(in, di, uo) is det.
+
display_close_result(ok) --> [].
display_close_result(error(String)) -->
print(String),
nl.
-
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.27
diff -u -b -r1.27 declarative_debugger.m
--- browser/declarative_debugger.m 2002/05/15 11:24:07 1.27
+++ browser/declarative_debugger.m 2002/07/17 01:47:48
@@ -1361,7 +1361,7 @@
:- pragma foreign_proc("C",
debug_origin(Flag::out, IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Flag = MR_DD_debug_origin;
IO = IO0;
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.19
diff -u -b -r1.19 declarative_execution.m
--- browser/declarative_execution.m 2002/05/15 11:24:07 1.19
+++ browser/declarative_execution.m 2002/07/17 03:58:09
@@ -589,13 +589,13 @@
trace_node(trace_node_id)).
:- mode search_trace_node_store(in, in, out) is semidet.
-:- pragma c_code(
+:- pragma foreign_proc("C",
search_trace_node_store(_Store::in, Id::in, Node::out),
- [will_not_call_mercury, thread_safe],
- "
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
Node = Id;
SUCCESS_INDICATOR = (Id != (MR_Word) NULL);
- "
+"
).
%
@@ -951,10 +951,10 @@
:- pred null_trace_node_id(trace_node_id).
:- mode null_trace_node_id(out) is det.
-:- pragma c_code(
+:- pragma foreign_proc("C",
null_trace_node_id(Id::out),
- [will_not_call_mercury, thread_safe],
- "Id = (MR_Word) NULL;"
+ [will_not_call_mercury, promise_pure, thread_safe],
+"Id = (MR_Word) NULL;"
).
:- func construct_trace_atom(pred_or_func, string, int) = trace_atom.
@@ -1087,16 +1087,16 @@
:- pred node_id_to_key(trace_node_id, trace_node_key).
:- mode node_id_to_key(in, out) is det.
-:- pragma c_code(node_id_to_key(Id::in, Key::out),
- [will_not_call_mercury, thread_safe],
- "Key = (MR_Integer) Id;").
+:- pragma foreign_proc("C", node_id_to_key(Id::in, Key::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"Key = (MR_Integer) Id;").
:- pred convert_node(trace_node(trace_node_id), trace_node(trace_node_key)).
:- mode convert_node(in, out) is det.
-:- pragma c_code(convert_node(N1::in, N2::out),
- [will_not_call_mercury, thread_safe],
- "N2 = N1;").
+:- pragma foreign_proc("C", convert_node(N1::in, N2::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"N2 = N1;").
% Given a node in an annotated trace, return a reference to
% the preceding node in the trace, or a NULL reference if
Index: browser/dl.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/dl.m,v
retrieving revision 1.18
diff -u -b -r1.18 dl.m
--- browser/dl.m 2002/03/20 15:52:55 1.18
+++ browser/dl.m 2002/07/18 05:58:23
@@ -35,7 +35,7 @@
% high-level interface to the C function dlsym().
% This version returns a higher-order predicate or function term.
-% The user must use an inst cast (implemented using pragma c_code)
+% The user must use an inst cast (implemented using foreign_proc)
% to cast this term to the appropriate higher-order inst before calling
% it; see dl_test.m for an example of this.
%
@@ -93,9 +93,9 @@
:- type handle ---> handle(c_pointer).
:- pred is_null(c_pointer::in) is semidet.
-:- pragma c_code(is_null(Pointer::in),
- [will_not_call_mercury, thread_safe],
- "SUCCESS_INDICATOR = ((void *)Pointer == NULL)").
+:- pragma foreign_proc("C", is_null(Pointer::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"SUCCESS_INDICATOR = ((void *) Pointer == NULL)").
open(FileName, Mode, Scope, Result) -->
dlopen(FileName, Mode, Scope, Pointer),
@@ -114,9 +114,11 @@
:- pred dlopen(string::in, (mode)::in, scope::in, c_pointer::out,
io__state::di, io__state::uo) is det.
-:- pragma c_code(dlopen(FileName::in, Mode::in, Scope::in, Result::out,
- _IO0::di, _IO::uo), [], "
-{
+:- pragma foreign_proc("C",
+ dlopen(FileName::in, Mode::in, Scope::in, Result::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"{
#if defined(MR_HAVE_DLFCN_H) && defined(MR_HAVE_DLOPEN) \
&& defined(RTLD_NOW) && defined(RTLD_LAZY)
int mode = (Mode ? RTLD_NOW : RTLD_LAZY);
@@ -249,7 +251,7 @@
MR_Box arg16, MR_Box arg17, MR_Box arg18, MR_Box arg19, MR_Box arg20);
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
/*
** For the --high-level-code grades, the closure will be passed
@@ -308,8 +310,9 @@
").
:- func dl__generic_closure_wrapper = c_pointer.
-:- pragma c_code(dl__generic_closure_wrapper = (WrapperFuncAddr::out),
- [thread_safe, will_not_call_mercury],
+:- pragma foreign_proc("C",
+ dl__generic_closure_wrapper = (WrapperFuncAddr::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
"
WrapperFuncAddr = (MR_Word) &ML_DL_generic_closure_wrapper;
").
@@ -432,9 +435,10 @@
:- pred dlsym(c_pointer::in, string::in, c_pointer::out,
io__state::di, io__state::uo) is det.
-:- pragma c_code(dlsym(Handle::in, Name::in, Pointer::out,
- _IO0::di, _IO::uo), [will_not_call_mercury], "
-{
+:- pragma foreign_proc("C",
+ dlsym(Handle::in, Name::in, Pointer::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"{
#if defined(MR_HAVE_DLFCN_H) && defined(MR_HAVE_DLSYM)
Pointer = (MR_Word) dlsym((void *) Handle, Name);
#else
@@ -443,8 +447,8 @@
}").
:- pred dlerror(string::out, io__state::di, io__state::uo) is det.
-:- pragma c_code(dlerror(ErrorMsg::out, _IO0::di, _IO::uo),
- [will_not_call_mercury], "
+:- pragma foreign_proc("C", dlerror(ErrorMsg::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io], "
{
const char *msg;
@@ -470,16 +474,20 @@
** to declare this as `will_not_call_mercury'.
*/
:- pred dlclose(c_pointer::in, io__state::di, io__state::uo) is det.
-:- pragma c_code(dlclose(Handle::in, _IO0::di, _IO::uo), [], "
+:- pragma foreign_proc("C", dlclose(Handle::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
#if defined(MR_HAVE_DLFCN_H) && defined(MR_HAVE_DLCLOSE)
- dlclose((void *)Handle)
+ dlclose((void *) Handle);
#endif
").
%-----------------------------------------------------------------------------%
:- pred high_level_code is semidet.
-:- pragma c_code(high_level_code, [will_not_call_mercury, thread_safe], "
+:- pragma foreign_proc("C", high_level_code,
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"
#ifdef MR_HIGHLEVEL_CODE
SUCCESS_INDICATOR = MR_TRUE;
#else
Index: browser/io_action.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/io_action.m,v
retrieving revision 1.2
diff -u -b -r1.2 io_action.m
--- browser/io_action.m 2002/06/28 12:17:13 1.2
+++ browser/io_action.m 2002/07/17 04:20:36
@@ -87,7 +87,7 @@
:- pragma foreign_proc("C",
pickup_io_action(SeqNum::in, ProcName::out, IsFunc::out, Args::out,
S0::di, S::uo),
- [thread_safe, promise_pure],
+ [thread_safe, promise_pure, tabled_for_io],
"{
const char *problem;
const char *proc_name;
Index: browser/mdb.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/mdb.m,v
retrieving revision 1.7
diff -u -b -r1.7 mdb.m
--- browser/mdb.m 2002/05/15 11:24:10 1.7
+++ browser/mdb.m 2002/07/17 03:55:26
@@ -30,8 +30,9 @@
% See library/library.m for why we implement this predicate this way.
-:- pragma c_code(mdb__version(Version::out),
- will_not_call_mercury, "
+:- pragma foreign_proc("C", mdb__version(Version::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
MR_ConstString version_string =
MR_VERSION "", configured for "" MR_FULLARCH;
/*
Index: browser/name_mangle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/name_mangle.m,v
retrieving revision 1.6
diff -u -b -r1.6 name_mangle.m
--- browser/name_mangle.m 2002/02/18 07:00:49 1.6
+++ browser/name_mangle.m 2002/07/17 03:55:10
@@ -248,7 +248,9 @@
).
:- pred use_asm_labels is semidet.
-:- pragma c_code(use_asm_labels, [will_not_call_mercury, thread_safe], "
+:- pragma foreign_proc("C", use_asm_labels,
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
#ifdef MR_USE_ASM_LABELS
SUCCESS_INDICATOR = MR_TRUE;
#else
@@ -257,7 +259,9 @@
").
:- pred high_level_code is semidet.
-:- pragma c_code(high_level_code, [will_not_call_mercury, thread_safe], "
+:- pragma foreign_proc("C", high_level_code,
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
#ifdef MR_HIGHLEVEL_CODE
SUCCESS_INDICATOR = MR_TRUE;
#else
Index: browser/util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/util.m,v
retrieving revision 1.15
diff -u -b -r1.15 util.m
--- browser/util.m 2002/02/18 07:00:49 1.15
+++ browser/util.m 2002/07/17 04:02:15
@@ -81,26 +81,25 @@
%---------------------------------------------------------------------------%
:- implementation.
-:- import_module int, require.
+:- import_module bool, int, require.
util__trace_getline(Prompt, Result) -->
io__input_stream(MdbIn),
io__output_stream(MdbOut),
util__trace_getline(Prompt, Result, MdbIn, MdbOut).
-:- pragma promise_pure(util__trace_getline/6).
-
util__trace_getline(Prompt, Result, MdbIn, MdbOut) -->
+ call_trace_getline(MdbIn, MdbOut, Prompt, Line, Success),
{
- impure call_trace_getline(MdbIn, MdbOut, Prompt, Line)
- ->
+ Success = yes,
Result = ok(Line)
;
+ Success = no,
Result = eof
}.
-:- impure pred call_trace_getline(input_stream, output_stream, string, string).
-:- mode call_trace_getline(in, in, in, out) is semidet.
+:- pred call_trace_getline(input_stream::in, output_stream::in, string::in,
+ string::out, bool::out, io__state::di, io__state::uo) is det.
:- pragma c_header_code("
#include ""mercury_wrapper.h""
@@ -108,12 +107,14 @@
#include ""mercury_trace_base.h""
#include ""mercury_trace_internal.h""
#include ""mercury_library_types.h""
+ #include ""bool.h""
").
-:- pragma c_code(call_trace_getline(MdbIn::in, MdbOut::in, Prompt::in,
- Line::out),
- [will_not_call_mercury],
- "
+:- pragma foreign_proc("C",
+ call_trace_getline(MdbIn::in, MdbOut::in, Prompt::in, Line::out,
+ Success::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
char *line;
MercuryFile *mdb_in = (MercuryFile *) MdbIn;
MercuryFile *mdb_out = (MercuryFile *) MdbOut;
@@ -127,24 +128,26 @@
}
if (line == NULL) {
- SUCCESS_INDICATOR = MR_FALSE;
+ /* we copy the null string to avoid warnings about const */
+ MR_make_aligned_string_copy(Line, """");
+ Success = ML_bool_return_no();
} else {
MR_make_aligned_string_copy(Line, line);
MR_free(line);
- SUCCESS_INDICATOR = MR_TRUE;
+ Success = ML_bool_return_yes();
}
- "
-).
+").
util__trace_get_command(Prompt, Result) -->
io__input_stream(MdbIn),
io__output_stream(MdbOut),
util__trace_get_command(Prompt, Result, MdbIn, MdbOut).
-:- pragma c_code(util__trace_get_command(Prompt::in, Line::out, MdbIn::in,
+:- pragma foreign_proc("C",
+ util__trace_get_command(Prompt::in, Line::out, MdbIn::in,
MdbOut::in, State0::di, State::uo),
- [will_not_call_mercury],
- "
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
char *line;
MercuryFile *mdb_in = (MercuryFile *) MdbIn;
MercuryFile *mdb_out = (MercuryFile *) MdbOut;
@@ -162,8 +165,7 @@
MR_free(line);
State = State0;
- "
-).
+").
util__zip_with(Pred, XXs, YYs, Zipped) :-
( (XXs = [], YYs = []) ->
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/gcc.m,v
retrieving revision 1.25
diff -u -b -r1.25 gcc.m
--- compiler/gcc.m 2002/02/21 17:03:57 1.25
+++ compiler/gcc.m 2002/07/17 12:55:58
@@ -752,11 +752,15 @@
% Returns `yes' iff we've already entered the gcc back-end.
:- pred in_gcc(bool::out, io__state::di, io__state::uo) is det.
-:- pragma import(in_gcc(out, di, uo), "MC_in_gcc").
+:- pragma import(in_gcc(out, di, uo),
+ [will_not_call_mercury, tabled_for_io],
+ "MC_in_gcc").
:- pred call_gcc_backend(string::in, int::out,
io__state::di, io__state::uo) is det.
-:- pragma import(call_gcc_backend(in, out, di, uo), "MC_call_gcc_backend").
+:- pragma import(call_gcc_backend(in, out, di, uo),
+ [will_not_call_mercury, tabled_for_io],
+ "MC_call_gcc_backend").
:- pragma c_header_code("
/* We use an `MC_' prefix for C code in the mercury/compiler directory. */
@@ -774,7 +778,7 @@
#include <stdlib.h> /* for exit() */
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
/* We use an `MC_' prefix for C code in the mercury/compiler directory. */
MR_Word MC_frontend_callback;
@@ -878,26 +882,31 @@
:- pred set_global_frontend_callback_output(T::in,
io__state::di, io__state::uo) is det.
-:- pragma c_code(get_global_frontend_callback(CallBack::out(frontend_callback),
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ get_global_frontend_callback(CallBack::out(frontend_callback),
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
CallBack = MC_frontend_callback;
").
-:- pragma c_code(set_global_frontend_callback(CallBack::in(frontend_callback),
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ set_global_frontend_callback(CallBack::in(frontend_callback),
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
MC_frontend_callback = CallBack;
MC_frontend_callback_type = TypeInfo_for_T;
").
-:- pragma c_code(get_global_frontend_callback_output(Output::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ get_global_frontend_callback_output(Output::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Output = MC_frontend_callback_output;
").
-:- pragma c_code(set_global_frontend_callback_output(Output::in,
- _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ set_global_frontend_callback_output(Output::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
MC_frontend_callback_output = Output;
").
@@ -916,58 +925,100 @@
:- type gcc__func_decl == gcc__type.
-:- pragma c_code(void_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ void_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
Type = (MR_Word) void_type_node;
").
-:- pragma c_code(boolean_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ boolean_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
Type = (MR_Word) boolean_type_node;
").
-:- pragma c_code(char_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ char_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
Type = (MR_Word) char_type_node;
").
-:- pragma c_code(string_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ string_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
/*
** XXX we should consider using const when appropriate,
** i.e. when the string doesn't have a unique mode
*/
Type = (MR_Word) string_type_node;
").
-:- pragma c_code(double_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ double_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
Type = (MR_Word) double_type_node;
").
-:- pragma c_code(ptr_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ ptr_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
Type = (MR_Word) ptr_type_node;
").
-:- pragma c_code(integer_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ integer_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
Type = (MR_Word) integer_type_node;
").
-:- pragma c_code(int8_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ int8_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
Type = (MR_Word) merc_int8_type_node;
").
-:- pragma c_code(int16_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ int16_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
Type = (MR_Word) merc_int16_type_node;
").
-:- pragma c_code(int32_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ int32_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
Type = (MR_Word) merc_int32_type_node;
").
-:- pragma c_code(int64_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ int64_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
Type = (MR_Word) merc_int64_type_node;
").
-:- pragma c_code(intptr_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ intptr_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
Type = (MR_Word) merc_intptr_type_node;
").
-:- pragma c_code(jmpbuf_type_node = (Type::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ jmpbuf_type_node = (Type::out),
+ [will_not_call_mercury, promise_pure],
+"
Type = (MR_Word) merc_jmpbuf_type_node;
").
-:- pragma c_code(build_pointer_type(Type::in, PtrType::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_pointer_type(Type::in, PtrType::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
PtrType = (MR_Word) build_pointer_type((tree) Type);
").
-:- pragma c_code(build_array_type(ElemType::in, NumElems::in, ArrayType::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_array_type(ElemType::in, NumElems::in, ArrayType::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
/* XXX Move this code to `mercury-gcc.c'. */
/* XXX Do we need to check that NumElems fits in a HOST_WIDE_INT? */
@@ -977,8 +1028,10 @@
ArrayType = (MR_Word) build_array_type((tree) ElemType, index_type);
").
-:- pragma c_code(build_range_type(Type::in, Min::in, Max::in, RangeType::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_range_type(Type::in, Min::in, Max::in, RangeType::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
RangeType = (MR_Word) build_range_type((tree) Type,
build_int_2 (Min, (Min < 0 ? -1 : 0)),
@@ -987,39 +1040,48 @@
:- type gcc__param_types == gcc__tree.
-:- pragma c_code(empty_param_types = (ParamTypes::out), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ empty_param_types = (ParamTypes::out),
+ [will_not_call_mercury, promise_pure],
"
ParamTypes = (MR_Word) merc_empty_param_type_list();
").
-:- pragma c_code(cons_param_types(Type::in, Types0::in) = (Types::out),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ cons_param_types(Type::in, Types0::in) = (Types::out),
+ [will_not_call_mercury, promise_pure],
"
Types = (MR_Word)
merc_cons_param_type_list((tree) Type, (tree) Types0);
").
-:- pragma c_code(build_function_type(RetType::in, ParamTypes::in,
- FunctionType::out, _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_function_type(RetType::in, ParamTypes::in, FunctionType::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
FunctionType = (MR_Word) build_function_type((tree) RetType,
(tree) ParamTypes);
").
-:- pragma c_code(declared_type(TypeDecl::in) = (Type::out),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ declared_type(TypeDecl::in) = (Type::out),
+ [will_not_call_mercury, promise_pure],
"
Type = (MR_Word) TREE_TYPE((tree) TypeDecl);
").
-:- pragma c_code(get_array_elem_type(ArrayType::in, ElemType::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ get_array_elem_type(ArrayType::in, ElemType::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
ElemType = (MR_Word) TREE_TYPE((tree) ArrayType);
").
-:- pragma c_code(get_struct_field_decls(StructType::in, FieldDecls::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ get_struct_field_decls(StructType::in, FieldDecls::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
FieldDecls = (MR_Word) TYPE_FIELDS((tree) StructType);
").
@@ -1035,45 +1097,54 @@
:- type gcc__var_decl == gcc__tree.
-:- pragma c_code(build_extern_var_decl(Name::in, Type::in, Decl::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_extern_var_decl(Name::in, Type::in, Decl::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Decl = (MR_Word) merc_build_extern_var_decl(Name, (tree) Type);
").
-:- pragma c_code(build_static_var_decl(Name::in, Type::in, Init::in, Decl::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_static_var_decl(Name::in, Type::in, Init::in, Decl::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Decl = (MR_Word) merc_build_static_var_decl(Name, (tree) Type,
(tree) Init);
").
-:- pragma c_code(finish_static_var_decl(Decl::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ finish_static_var_decl(Decl::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
merc_finish_static_var_decl((tree) Decl);
").
-:- pragma c_code(build_local_var_decl(Name::in, Type::in, Decl::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_local_var_decl(Name::in, Type::in, Decl::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Decl = (MR_Word) merc_build_local_var_decl(Name, (tree) Type);
").
-:- pragma c_code(set_var_decl_public(Decl::in,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ set_var_decl_public(Decl::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
TREE_PUBLIC((tree) Decl) = 1;
").
-:- pragma c_code(set_var_decl_readonly(Decl::in,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ set_var_decl_readonly(Decl::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
TREE_READONLY((tree) Decl) = 1;
").
-:- pragma c_code(set_var_decl_asm_name(Decl::in, AsmName::in,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ set_var_decl_asm_name(Decl::in, AsmName::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
DECL_ASSEMBLER_NAME((tree) Decl) = get_identifier(AsmName);
").
@@ -1084,69 +1155,81 @@
:- type gcc__param_decls == gcc__tree.
-:- pragma c_code(build_param_decl(Name::in, Type::in, Decl::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_param_decl(Name::in, Type::in, Decl::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Decl = (MR_Word) merc_build_param_decl(Name, (tree) Type);
").
-:- pragma c_code(empty_param_decls = (Decl::out), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ empty_param_decls = (Decl::out),
+ [will_not_call_mercury, promise_pure],
"
Decl = (MR_Word) merc_empty_param_list();
").
-:- pragma c_code(cons_param_decls(Decl::in, Decls0::in) = (Decls::out),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ cons_param_decls(Decl::in, Decls0::in) = (Decls::out),
+ [will_not_call_mercury, promise_pure],
"
Decls = (MR_Word) merc_cons_param_list((tree) Decl, (tree) Decls0);
").
-:- pragma c_code(build_function_decl(Name::in, AsmName::in,
- RetType::in, ParamTypes::in, Params::in, Decl::out, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_function_decl(Name::in, AsmName::in, RetType::in, ParamTypes::in,
+ Params::in, Decl::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Decl = (MR_Word) merc_build_function_decl(Name, AsmName,
(tree) RetType, (tree) ParamTypes, (tree) Params);
").
-:- pragma c_code(alloc_func_decl = (Decl::out),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ alloc_func_decl = (Decl::out),
+ [will_not_call_mercury, promise_pure],
"
Decl = (MR_Word) merc_alloc_function_node;
").
-:- pragma c_code(strcmp_func_decl = (Decl::out),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ strcmp_func_decl = (Decl::out),
+ [will_not_call_mercury, promise_pure],
"
Decl = (MR_Word) merc_strcmp_function_node;
").
-:- pragma c_code(hash_string_func_decl = (Decl::out),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ hash_string_func_decl = (Decl::out),
+ [will_not_call_mercury, promise_pure],
"
Decl = (MR_Word) merc_hash_string_function_node;
").
-:- pragma c_code(box_float_func_decl = (Decl::out),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ box_float_func_decl = (Decl::out),
+ [will_not_call_mercury, promise_pure],
"
Decl = (MR_Word) merc_box_float_function_node;
").
-:- pragma c_code(setjmp_func_decl = (Decl::out),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ setjmp_func_decl = (Decl::out),
+ [will_not_call_mercury, promise_pure],
"
Decl = (MR_Word) merc_setjmp_function_node;
").
-:- pragma c_code(longjmp_func_decl = (Decl::out),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ longjmp_func_decl = (Decl::out),
+ [will_not_call_mercury, promise_pure],
"
Decl = (MR_Word) merc_longjmp_function_node;
").
-:- pragma c_code(set_func_decl_public(Decl::in,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ set_func_decl_public(Decl::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
TREE_PUBLIC((tree) Decl) = 1;
").
@@ -1157,34 +1240,40 @@
:- type gcc__field_decl == gcc__tree.
-:- pragma c_code(build_field_decl(Name::in, Type::in, Decl::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_field_decl(Name::in, Type::in, Decl::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Decl = (MR_Word) merc_build_field_decl(Name, (tree) Type);
").
-:- pragma c_code(field_type(Decl::in, Type::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ field_type(Decl::in, Type::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Type = (MR_Word) TREE_TYPE((tree) Decl);
").
:- type gcc__field_decls == gcc__tree.
-:- pragma c_code(empty_field_list(Decl::out, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ empty_field_list(Decl::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Decl = (MR_Word) merc_empty_field_list();
").
-:- pragma c_code(cons_field_list(Decl::in, Decls0::in, Decls::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ cons_field_list(Decl::in, Decls0::in, Decls::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Decls = (MR_Word) merc_cons_field_list((tree) Decl, (tree) Decls0);
").
-:- pragma c_code(next_field_decl(Decls::in, Decl::out, RemainingDecls::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ next_field_decl(Decls::in, Decl::out, RemainingDecls::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
assert((tree) Decls != NULL_TREE);
Decl = (MR_Word) (tree) Decls;
@@ -1193,9 +1282,10 @@
:- type gcc__type_decl == gcc__tree.
-:- pragma c_code(build_struct_type_decl(Name::in, FieldTypes::in, Decl::out,
+:- pragma foreign_proc("C",
+ build_struct_type_decl(Name::in, FieldTypes::in, Decl::out,
_IO0::di, _IO::uo),
- [will_not_call_mercury],
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Decl = (MR_Word) merc_build_struct_type_decl(Name, (tree) FieldTypes);
").
@@ -1207,75 +1297,141 @@
:- type gcc__op == gcc__tree_code.
-:- pragma c_code(plus_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ plus_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = PLUS_EXPR;
").
-:- pragma c_code(minus_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ minus_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = MINUS_EXPR;
").
-:- pragma c_code(mult_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ mult_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = MULT_EXPR;
").
-:- pragma c_code(rdiv_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ rdiv_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = RDIV_EXPR;
").
-:- pragma c_code(trunc_div_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ trunc_div_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = TRUNC_DIV_EXPR;
").
-:- pragma c_code(trunc_mod_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ trunc_mod_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = TRUNC_MOD_EXPR;
").
-:- pragma c_code(eq_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ eq_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = EQ_EXPR;
").
-:- pragma c_code(ne_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ ne_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = NE_EXPR;
").
-:- pragma c_code(lt_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ lt_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = LT_EXPR;
").
-:- pragma c_code(gt_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ gt_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = GT_EXPR;
").
-:- pragma c_code(le_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ le_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = LE_EXPR;
").
-:- pragma c_code(ge_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ ge_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = GE_EXPR;
").
-:- pragma c_code(truth_andif_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ truth_andif_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = TRUTH_ANDIF_EXPR;
").
-:- pragma c_code(truth_orif_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ truth_orif_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = TRUTH_ORIF_EXPR;
").
-:- pragma c_code(truth_not_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ truth_not_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = TRUTH_NOT_EXPR;
").
-:- pragma c_code(bit_ior_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ bit_ior_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = BIT_IOR_EXPR;
").
-:- pragma c_code(bit_xor_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ bit_xor_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = BIT_XOR_EXPR;
").
-:- pragma c_code(bit_and_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ bit_and_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = BIT_AND_EXPR;
").
-:- pragma c_code(bit_not_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ bit_not_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = BIT_NOT_EXPR;
").
-:- pragma c_code(lshift_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ lshift_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = LSHIFT_EXPR;
").
-:- pragma c_code(rshift_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ rshift_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = RSHIFT_EXPR;
").
-:- pragma c_code(array_ref = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ array_ref = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = ARRAY_REF;
").
@@ -1286,8 +1442,9 @@
:- type gcc__expr == gcc__tree.
-:- pragma c_code(expr_type(Expr::in, Type::out, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ expr_type(Expr::in, Type::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Type = (MR_Word) TREE_TYPE((tree) Expr);
").
@@ -1307,8 +1464,9 @@
:- pred build_int_2(int, int, gcc__expr, io__state, io__state).
:- mode build_int_2(in, in, out, di, uo) is det.
-:- pragma c_code(build_int_2(Low::in, High::in, Expr::out, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_int_2(Low::in, High::in, Expr::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Expr = (MR_Word) build_int_2(Low, High);
").
@@ -1321,8 +1479,9 @@
:- pred build_real(gcc__type, float, gcc__expr, io__state, io__state).
:- mode build_real(in, in, out, di, uo) is det.
-:- pragma c_code(build_real(Type::in, Value::in, Expr::out, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_real(Type::in, Value::in, Expr::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Expr = (MR_Word) merc_build_real((tree) Type, Value);
").
@@ -1330,14 +1489,16 @@
build_string(String, Expr) -->
build_string(string__length(String) + 1, String, Expr).
-:- pragma c_code(build_string(Len::in, String::in, Expr::out, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_string(Len::in, String::in, Expr::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Expr = (MR_Word) merc_build_string(Len, String);
").
-:- pragma c_code(build_null_pointer(NullPointerExpr::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_null_pointer(NullPointerExpr::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
NullPointerExpr = (MR_Word) null_pointer_node;
").
@@ -1346,20 +1507,25 @@
% operator expressions
%
-:- pragma c_code(build_unop(Op::in, Type::in, Arg::in, Expr::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_unop(Op::in, Type::in, Arg::in, Expr::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Expr = (MR_Word) fold(build1(Op, (tree) Type, (tree) Arg));
").
-:- pragma c_code(build_binop(Op::in, Type::in, Arg1::in, Arg2::in, Expr::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_binop(Op::in, Type::in, Arg1::in, Arg2::in, Expr::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Expr = (MR_Word) fold(build(Op, (tree) Type, (tree) Arg1, (tree) Arg2));
").
-:- pragma c_code(build_pointer_deref(Pointer::in, DerefExpr::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_pointer_deref(Pointer::in, DerefExpr::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
/* XXX should move to mercury-gcc.c */
tree ptr = (tree) Pointer;
@@ -1368,8 +1534,10 @@
DerefExpr = (MR_Word) build1 (INDIRECT_REF, type, ptr);
").
-:- pragma c_code(build_component_ref(ObjectExpr::in, FieldDecl::in,
- FieldExpr::out, _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_component_ref(ObjectExpr::in, FieldDecl::in, FieldExpr::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
/* XXX should move to mercury-gcc.c */
tree field_type = TREE_TYPE ((tree) FieldDecl);
@@ -1377,8 +1545,9 @@
(tree) ObjectExpr, (tree) FieldDecl);
").
-:- pragma c_code(convert_type(Expr::in, Type::in, ResultExpr::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ convert_type(Expr::in, Type::in, ResultExpr::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
/*
** XXX should we use convert() instead?
@@ -1405,13 +1574,17 @@
build_unop(addr_expr, PtrType, Expr, AddrExpr).
:- func addr_expr = gcc__op. % & (address-of)
-:- pragma c_code(addr_expr = (Code::out), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ addr_expr = (Code::out),
+ [will_not_call_mercury, promise_pure],
+"
Code = ADDR_EXPR;
").
:- pred mark_addressable(gcc__expr::in, io__state::di, io__state::uo) is det.
-:- pragma c_code(mark_addressable(Expr::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ mark_addressable(Expr::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
mark_addressable((tree) Expr);
").
@@ -1436,21 +1609,25 @@
:- type gcc__arg_list == gcc__tree.
-:- pragma c_code(empty_arg_list(ArgList::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ empty_arg_list(ArgList::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
ArgList = (MR_Word) merc_empty_arg_list();
").
-:- pragma c_code(cons_arg_list(Arg::in, ArgList0::in, ArgList::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ cons_arg_list(Arg::in, ArgList0::in, ArgList::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
ArgList = (MR_Word)
merc_cons_arg_list((tree) Arg, (tree) ArgList0);
").
-:- pragma c_code(build_call_expr(Func::in, Args::in, IsTailCall::in,
- CallExpr::out, _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_call_expr(Func::in, Args::in, IsTailCall::in, CallExpr::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
CallExpr = (MR_Word) merc_build_call_expr((tree) Func, (tree) Args,
(int) IsTailCall);
@@ -1469,22 +1646,26 @@
:- type gcc__init_list == gcc__tree.
-:- pragma c_code(empty_init_list(InitList::out,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ empty_init_list(InitList::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
InitList = (MR_Word) merc_empty_init_list();
").
-:- pragma c_code(cons_init_list(Elem::in, Init::in,
- InitList0::in, InitList::out, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ cons_init_list(Elem::in, Init::in, InitList0::in, InitList::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
InitList = (MR_Word)
merc_cons_init_list((tree) Elem, (tree) Init, (tree) InitList0);
").
-:- pragma c_code(build_initializer_expr(InitList::in, Type::in,
- Expr::out, _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_initializer_expr(InitList::in, Type::in, Expr::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Expr = (MR_Word) build(CONSTRUCTOR, (tree) Type, NULL_TREE,
(tree) InitList);
@@ -1496,10 +1677,12 @@
% collector (see gcc/ggc.h).
%
-:- pragma import(push_gc_context(di, uo), [will_not_call_mercury],
+:- pragma import(push_gc_context(di, uo),
+ [will_not_call_mercury, tabled_for_io],
"ggc_push_context").
-:- pragma import(pop_gc_context(di, uo), [will_not_call_mercury],
+:- pragma import(pop_gc_context(di, uo),
+ [will_not_call_mercury, tabled_for_io],
"ggc_pop_context").
%-----------------------------------------------------------------------------%
@@ -1507,23 +1690,27 @@
% Functions
%
-:- pragma c_code(start_function(FuncDecl::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ start_function(FuncDecl::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
merc_start_function((tree) FuncDecl);
").
-:- pragma import(end_function(di, uo), [will_not_call_mercury],
+:- pragma import(end_function(di, uo),
+ [will_not_call_mercury, tabled_for_io],
"merc_end_function").
-:- pragma c_code(set_context(FileName::in, LineNumber::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ set_context(FileName::in, LineNumber::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
merc_set_context(FileName, LineNumber);
").
-:- pragma c_code(gen_line_note(FileName::in, LineNumber::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_line_note(FileName::in, LineNumber::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
emit_line_note(FileName, LineNumber);
").
@@ -1537,15 +1724,17 @@
% blocks
%
-:- pragma c_code(start_block(_IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ start_block(_IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
pushlevel(0);
expand_start_bindings(0);
").
-:- pragma c_code(end_block(_IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ end_block(_IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
tree block = poplevel(/*keep=*/1, /*reverse=*/1, /*functionbody=*/0);
expand_end_bindings(block, /*mark_ends=*/1, /*dont_jump_in=*/0);
@@ -1555,48 +1744,57 @@
% if-then-else
%
-:- pragma c_code(gen_start_cond(Cond::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_start_cond(Cond::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
expand_start_cond((tree) Cond, 0);
").
-:- pragma import(gen_start_else(di, uo), [will_not_call_mercury],
+:- pragma import(gen_start_else(di, uo),
+ [will_not_call_mercury, tabled_for_io],
"expand_start_else").
-:- pragma import(gen_end_cond(di, uo), [will_not_call_mercury],
+:- pragma import(gen_end_cond(di, uo),
+ [will_not_call_mercury, tabled_for_io],
"expand_end_cond").
%
% switch statements
%
-:- pragma c_code(gen_start_switch(Expr::in, Type::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_start_switch(Expr::in, Type::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
expand_start_case(1, (tree) Expr, (tree) Type, ""switch"");
").
-:- pragma c_code(gen_case_label(Value::in, Label::in,
- _IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_case_label(Value::in, Label::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
merc_gen_switch_case_label((tree) Value, (tree) Label);
").
-:- pragma c_code(gen_default_case_label(Label::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_default_case_label(Label::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
merc_gen_switch_case_label(NULL_TREE, (tree) Label);
").
-:- pragma c_code(gen_break(_IO0::di, _IO::uo), [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_break(_IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
int result = expand_exit_something();
assert(result != 0);
").
-:- pragma c_code(gen_end_switch(Expr::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_end_switch(Expr::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
expand_end_case((tree) Expr);
").
@@ -1609,22 +1807,25 @@
% C type `struct nesting *'
:- type gcc__loop ---> gcc__loop(c_pointer).
-:- pragma c_code(gen_start_loop(Loop::out, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_start_loop(Loop::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Loop = (MR_Word) expand_start_loop(0);
").
-:- pragma c_code(gen_exit_loop_if_false(Loop::in, Expr::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_exit_loop_if_false(Loop::in, Expr::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
int res = expand_exit_loop_if_false((struct nesting *) Loop,
(tree) Expr);
assert(res != 0);
").
-:- pragma c_code(gen_end_loop(_IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_end_loop(_IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
expand_end_loop();
").
@@ -1633,14 +1834,16 @@
% calls and return
%
-:- pragma c_code(gen_expr_stmt(Expr::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_expr_stmt(Expr::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
merc_gen_expr_stmt((tree) Expr);
").
-:- pragma c_code(gen_return(Expr::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_return(Expr::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
merc_gen_return((tree) Expr);
").
@@ -1649,8 +1852,9 @@
% assignment
%
-:- pragma c_code(gen_assign(LHS::in, RHS::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_assign(LHS::in, RHS::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
merc_gen_assign((tree) LHS, (tree) RHS);
").
@@ -1661,26 +1865,30 @@
:- type gcc__label == gcc__tree.
-:- pragma c_code(build_label(Name::in, Label::out, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_label(Name::in, Label::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Label = (MR_Word) merc_build_label(Name);
").
-:- pragma c_code(build_unnamed_label(Label::out, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ build_unnamed_label(Label::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
Label = (MR_Word) merc_build_label(NULL);
").
-:- pragma c_code(gen_label(Label::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_label(Label::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
expand_label((tree) Label);
").
-:- pragma c_code(gen_goto(Label::in, _IO0::di, _IO::uo),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ gen_goto(Label::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
expand_goto((tree) Label);
").
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.143
diff -u -b -r1.143 handle_options.m
--- compiler/handle_options.m 2002/07/15 07:03:50 1.143
+++ compiler/handle_options.m 2002/07/16 08:25:58
@@ -606,6 +606,8 @@
% --trace-table-io-decl is an extension of --trace-table-io
option_implies(trace_table_io_decl, trace_table_io, bool(yes)),
+ % --trace-table-io-require is compulsory application of --trace-table-io
+ option_implies(trace_table_io_require, trace_table_io, bool(yes)),
% Execution tracing requires
% - disabling optimizations that would change
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.257
diff -u -b -r1.257 mercury_compile.m
--- compiler/mercury_compile.m 2002/07/09 01:29:23 1.257
+++ compiler/mercury_compile.m 2002/07/17 12:57:28
@@ -166,7 +166,10 @@
:- pred gc_init(io__state::di, io__state::uo) is det.
-:- pragma c_code(gc_init(_IO0::di, _IO::uo), [will_not_call_mercury], "
+:- pragma foreign_proc("C",
+ gc_init(_IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
#ifdef MR_CONSERVATIVE_GC
/*
** Explicitly force the initial heap size to be at least 4 Mb.
@@ -2614,7 +2617,7 @@
maybe_write_string(Verbose,
"% Transforming tabled predicates..."),
maybe_flush_output(Verbose),
- { table_gen__process_module(HLDS0, HLDS) },
+ table_gen__process_module(HLDS0, HLDS),
maybe_write_string(Verbose, " done.\n").
%-----------------------------------------------------------------------------%
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.376
diff -u -b -r1.376 options.m
--- compiler/options.m 2002/07/02 06:19:37 1.376
+++ compiler/options.m 2002/07/15 06:05:46
@@ -126,6 +126,7 @@
; trace_table_io
; trace_table_io_decl
; trace_table_io_states
+ ; trace_table_io_require
; delay_death
; suppress_trace
; stack_trace_higher_order
@@ -684,6 +685,7 @@
trace_table_io - bool(no),
trace_table_io_decl - bool(no),
trace_table_io_states - bool(no),
+ trace_table_io_require - bool(no),
suppress_trace - string(""),
delay_death - bool(yes),
stack_trace_higher_order - bool(no),
@@ -1238,6 +1240,7 @@
long_option("trace-table-io", trace_table_io).
long_option("trace-table-io-decl", trace_table_io_decl).
long_option("trace-table-io-states", trace_table_io_states).
+long_option("trace-table-io-require", trace_table_io_require).
long_option("suppress-trace", suppress_trace).
long_option("delay-death", delay_death).
long_option("stack-trace-higher-order", stack_trace_higher_order).
@@ -2312,6 +2315,10 @@
% "\tWhen tabling I/O actions, table the io__state arguments",
% "\ttogether with the others. This should be required iff",
% "\tvalues of type io__state actually contain information.",
+% "--trace-table-io-require",
+% "\tRequire the tabling of I/O actions, i.e. generate an error",
+% "\tif an I/O primitive does not have the tabled_for_io",
+% "\tannotation.",
"--no-delay-death",
"\tWhen the trace level is `deep', the compiler normally",
"\tpreserves the values of variables as long as possible, even",
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/passes_aux.m,v
retrieving revision 1.48
diff -u -b -r1.48 passes_aux.m
--- compiler/passes_aux.m 2002/06/26 08:31:26 1.48
+++ compiler/passes_aux.m 2002/07/17 13:33:55
@@ -553,8 +553,9 @@
% Are we compiling in a win32 environment?
:- pred use_win32 is semidet.
-:- pragma c_code(use_win32,
- [will_not_call_mercury, thread_safe],
+:- pragma foreign_proc("C",
+ use_win32,
+ [will_not_call_mercury, promise_pure, thread_safe],
"
#ifdef MR_WIN32
SUCCESS_INDICATOR = 1;
Index: compiler/process_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/process_util.m,v
retrieving revision 1.3
diff -u -b -r1.3 process_util.m
--- compiler/process_util.m 2002/03/26 00:04:15 1.3
+++ compiler/process_util.m 2002/07/17 05:35:38
@@ -186,7 +186,7 @@
:- pragma foreign_proc("C",
setup_signal_handlers_2(SigintHandler::out, IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"{
IO = IO0;
MC_signalled = MR_FALSE;
@@ -226,7 +226,7 @@
:- pragma foreign_proc("C",
restore_signal_handlers_2(SigintHandler::in, IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"{
IO = IO0;
MR_set_signal_action(SIGINT, (MR_signal_action *) SigintHandler,
@@ -247,7 +247,7 @@
:- pragma foreign_proc("C",
check_for_signal(Signalled::out, Signal::out, IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
IO = IO0;
Signalled = (MC_signalled ? 1 : 0);
@@ -264,7 +264,7 @@
:- pragma foreign_proc("C",
raise_signal(Signal::in, IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"
IO = IO0;
raise(Signal);
@@ -313,7 +313,7 @@
:- pragma foreign_proc("C",
call_in_forked_process_2(Pred::in(io_pred),
ForkStatus::out, Status::out, IO0::di, IO::uo),
- [may_call_mercury, promise_pure],
+ [may_call_mercury, promise_pure, tabled_for_io],
"{
#ifdef MC_CAN_FORK
pid_t child_pid;
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.68
diff -u -b -r1.68 stack_layout.m
--- compiler/stack_layout.m 2002/05/16 13:14:48 1.68
+++ compiler/stack_layout.m 2002/07/17 13:34:54
@@ -160,9 +160,11 @@
#include ""mercury_misc.h"" /* for MR_fatal_error() */
").
-:- pragma c_code(stack_layout__concat_string_list(StringList::in,
- ArenaSize::in, Arena::out),
- [will_not_call_mercury, thread_safe], "{
+:- pragma foreign_proc("C",
+ stack_layout__concat_string_list(StringList::in, ArenaSize::in,
+ Arena::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"{
MR_Word cur_node;
MR_Integer cur_offset;
MR_Word tmp;
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.35
diff -u -b -r1.35 table_gen.m
--- compiler/table_gen.m 2002/06/30 17:06:40 1.35
+++ compiler/table_gen.m 2002/07/18 13:25:04
@@ -232,27 +232,30 @@
:- interface.
:- import_module hlds__hlds_module.
+:- import_module io.
-:- pred table_gen__process_module(module_info::in, module_info::out) is det.
+:- pred table_gen__process_module(module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module hlds__hlds_out, parse_tree__prog_out.
-:- import_module hlds__hlds_pred, hlds__instmap, check_hlds__polymorphism.
-:- import_module ll_backend__code_aux, check_hlds__det_analysis.
-:- import_module ll_backend__follow_code, hlds__goal_util.
+:- import_module parse_tree__prog_data, parse_tree__prog_out.
+:- import_module parse_tree__prog_util, parse_tree__inst.
+:- import_module hlds__hlds_module, hlds__hlds_pred.
+:- import_module hlds__hlds_goal, hlds__hlds_data.
+:- import_module hlds__instmap, hlds__passes_aux, hlds__error_util.
+:- import_module hlds__quantification, hlds__goal_util, hlds__hlds_out.
+:- import_module check_hlds__type_util, check_hlds__mode_util.
+:- import_module check_hlds__purity, check_hlds__modes, check_hlds__inst_match.
+:- import_module check_hlds__polymorphism, check_hlds__det_analysis.
:- import_module transform_hlds__const_prop.
-:- import_module hlds__hlds_module, hlds__hlds_goal, hlds__hlds_data.
-:- import_module (parse_tree__inst), check_hlds__inst_match.
-:- import_module libs__globals, libs__options, hlds__passes_aux.
-:- import_module parse_tree__prog_data, check_hlds__mode_util.
-:- import_module check_hlds__type_util.
-:- import_module ll_backend__code_util, hlds__quantification.
-:- import_module check_hlds__modes, check_hlds__purity, parse_tree__prog_util.
-:- import_module backend_libs__code_model, ll_backend__continuation_info.
-:- import_module backend_libs__rtti, ll_backend__llds.
+:- import_module ll_backend__llds, ll_backend__code_aux.
+:- import_module ll_backend__follow_code.
+:- import_module ll_backend__code_util, ll_backend__continuation_info.
+:- import_module backend_libs__code_model, backend_libs__rtti.
+:- import_module libs__globals, libs__options.
:- import_module term, varset.
:- import_module bool, int, string, list, assoc_list.
@@ -264,32 +267,35 @@
% The reason for this duplication is that this module needs a variant
% of this code that is able to handle passing a module_info to
% polymorphism and getting an updated module_info back.
-table_gen__process_module(ModuleInfo0, ModuleInfo) :-
+table_gen__process_module(ModuleInfo0, ModuleInfo, S0, S) :-
module_info_preds(ModuleInfo0, Preds0),
map__keys(Preds0, PredIds),
- table_gen__process_preds(PredIds, ModuleInfo0, ModuleInfo).
+ table_gen__process_preds(PredIds, ModuleInfo0, ModuleInfo, S0, S).
:- pred table_gen__process_preds(list(pred_id)::in,
- module_info::in, module_info::out) is det.
+ module_info::in, module_info::out, io__state::di, io__state::uo) is det.
-table_gen__process_preds([], ModuleInfo, ModuleInfo).
-table_gen__process_preds([PredId | PredIds], ModuleInfo0, ModuleInfo) :-
- table_gen__process_pred(PredId, ModuleInfo0, ModuleInfo1),
- table_gen__process_preds(PredIds, ModuleInfo1, ModuleInfo).
+table_gen__process_preds([], ModuleInfo, ModuleInfo, S, S).
+table_gen__process_preds([PredId | PredIds], ModuleInfo0, ModuleInfo, S0, S) :-
+ table_gen__process_pred(PredId, ModuleInfo0, ModuleInfo1, S0, S1),
+ table_gen__process_preds(PredIds, ModuleInfo1, ModuleInfo, S1, S).
-:- pred table_gen__process_pred(pred_id::in, module_info::in, module_info::out)
- is det.
+:- pred table_gen__process_pred(pred_id::in, module_info::in, module_info::out,
+ io__state::di, io__state::uo) is det.
-table_gen__process_pred(PredId, ModuleInfo0, ModuleInfo) :-
+table_gen__process_pred(PredId, ModuleInfo0, ModuleInfo, S0, S) :-
module_info_pred_info(ModuleInfo0, PredId, PredInfo),
pred_info_procids(PredInfo, ProcIds),
- table_gen__process_procs(PredId, ProcIds, ModuleInfo0, ModuleInfo).
+ table_gen__process_procs(PredId, ProcIds, ModuleInfo0, ModuleInfo,
+ S0, S).
:- pred table_gen__process_procs(pred_id::in, list(proc_id)::in,
- module_info::in, module_info::out) is det.
+ module_info::in, module_info::out, io__state::di, io__state::uo)
+ is det.
-table_gen__process_procs(_PredId, [], ModuleInfo, ModuleInfo).
-table_gen__process_procs(PredId, [ProcId | ProcIds], ModuleInfo0, ModuleInfo) :-
+table_gen__process_procs(_PredId, [], ModuleInfo, ModuleInfo, S, S).
+table_gen__process_procs(PredId, [ProcId | ProcIds], ModuleInfo0, ModuleInfo,
+ S0, S) :-
module_info_preds(ModuleInfo0, PredTable),
map__lookup(PredTable, PredId, PredInfo),
pred_info_procedures(PredInfo, ProcTable),
@@ -300,20 +306,43 @@
( eval_method_requires_tabling_transform(EvalMethod) = yes ->
table_gen__process_proc(EvalMethod, PredId, ProcId, ProcInfo0,
- PredInfo, ModuleInfo0, ModuleInfo1)
+ PredInfo, ModuleInfo0, ModuleInfo2),
+ S1 = S0
;
globals__lookup_bool_option(Globals, trace_table_io, yes),
+ globals__lookup_bool_option(Globals, trace_table_io_require,
+ Require),
proc_info_has_io_state_pair(ModuleInfo0, ProcInfo0,
_InArgNum, _OutArgNum),
proc_info_interface_code_model(ProcInfo0, model_det),
proc_info_goal(ProcInfo0, BodyGoal),
- some [SubGoal] (
+ some [SubGoal,Attrs] (
goal_contains_goal(BodyGoal, SubGoal),
SubGoal = foreign_proc(Attrs, _,_,_,_,_,_)
- _,
- tabled_for_io(Attrs, tabled_for_io)
+ ( tabled_for_io(Attrs, tabled_for_io)
+ ; Require = yes
)
+ ),
+ predicate_module(ModuleInfo0, PredId, PredModuleName),
+ \+ any_mercury_builtin_module(PredModuleName)
->
+ (
+ Require = yes,
+ some [SubGoal,Attrs] (
+ goal_contains_goal(BodyGoal, SubGoal),
+ SubGoal = foreign_proc(Attrs, _,_,_,_,_,_)
+ - _,
+ \+ tabled_for_io(Attrs, tabled_for_io)
+ )
+ ->
+ report_missing_tabled_for_io(ModuleInfo0, PredInfo,
+ PredId, ProcId, S0, S1),
+ module_info_incr_errors(ModuleInfo0, ModuleInfo1)
+ ;
+ ModuleInfo1 = ModuleInfo0,
+ S1 = S0
+ ),
globals__lookup_bool_option(Globals, trace_table_io_decl,
TraceTableIoDecl),
(
@@ -325,11 +354,25 @@
),
proc_info_set_eval_method(ProcInfo0, TableIoMethod, ProcInfo1),
table_gen__process_proc(TableIoMethod, PredId, ProcId,
- ProcInfo1, PredInfo, ModuleInfo0, ModuleInfo1)
+ ProcInfo1, PredInfo, ModuleInfo1, ModuleInfo2)
;
- ModuleInfo1 = ModuleInfo0
+ ModuleInfo2 = ModuleInfo0,
+ S1 = S0
),
- table_gen__process_procs(PredId, ProcIds, ModuleInfo1, ModuleInfo).
+ table_gen__process_procs(PredId, ProcIds, ModuleInfo2, ModuleInfo,
+ S1, S).
+
+%-----------------------------------------------------------------------------%
+
+:- pred report_missing_tabled_for_io(module_info::in, pred_info::in,
+ pred_id::in, proc_id::in, io__state::di, io__state::uo) is det.
+
+report_missing_tabled_for_io(ModuleInfo, PredInfo, PredId, ProcId) -->
+ { pred_info_context(PredInfo, Context) },
+ { error_util__describe_one_proc_name(ModuleInfo, proc(PredId, ProcId),
+ Name) },
+ { Msg = [fixed(Name), words("contains untabled I/O primitive.")] },
+ error_util__write_error_pieces(Context, 0, Msg).
%-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/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/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
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 java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/bool.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/bool.m,v
retrieving revision 1.7
diff -u -b -r1.7 bool.m
--- library/bool.m 2000/11/12 05:51:00 1.7
+++ library/bool.m 2002/07/17 03:52:20
@@ -101,4 +101,12 @@
bool__not(no, yes).
bool__not(yes, no).
+:- func bool__return_no = bool.
+:- func bool__return_yes = bool.
+:- pragma export(bool__return_no = out, "ML_bool_return_no").
+:- pragma export(bool__return_yes = out, "ML_bool_return_yes").
+
+bool__return_no = no.
+bool__return_yes = yes.
+
%-----------------------------------------------------------------------------%
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.262
diff -u -b -r1.262 io.m
--- library/io.m 2002/07/02 07:39:20 1.262
+++ library/io.m 2002/07/16 13:25:09
@@ -1941,7 +1941,7 @@
:- pragma foreign_proc("C", io__file_modification_time_2(FileName::in,
Status::out, Msg::out, Time::out, IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure, thread_safe],
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
#ifdef MR_HAVE_STAT
struct stat s;
@@ -1979,8 +1979,7 @@
:- pred io__alloc_buffer(int::in, buffer::uo) is det.
:- pragma foreign_proc("C",
io__alloc_buffer(Size::in, Buffer::uo),
- [will_not_call_mercury, promise_pure, tabled_for_io,
- thread_safe],
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
MR_incr_hp_atomic_msg(Buffer,
(Size * sizeof(MR_Char) + sizeof(MR_Word) - 1)
Index: library/table_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/table_builtin.m,v
retrieving revision 1.19
diff -u -b -r1.19 table_builtin.m
--- library/table_builtin.m 2002/06/24 11:09:07 1.19
+++ library/table_builtin.m 2002/07/17 16:37:30
@@ -498,6 +498,15 @@
if (MR_io_tabling_enabled) {
MR_Unsigned old_counter;
+#ifdef MR_DEBUG_RETRY
+ if (MR_io_tabling_debug) {
+ printf(""checking table_io_in_range: ""
+ ""prev %d, start %d, hwm %d"",
+ MR_io_tabling_counter, MR_io_tabling_start,
+ MR_io_tabling_counter_hwm);
+ }
+#endif
+
old_counter = MR_io_tabling_counter;
MR_io_tabling_counter++;
@@ -514,8 +523,20 @@
MR_io_tabling_counter;
}
+#ifdef MR_DEBUG_RETRY
+ if (MR_io_tabling_debug) {
+ printf("" in range\n"");
+ }
+#endif
+
SUCCESS_INDICATOR = MR_TRUE;
} else {
+
+#ifdef MR_DEBUG_RETRY
+ if (MR_io_tabling_debug) {
+ printf("" not in range\n"");
+ }
+#endif
SUCCESS_INDICATOR = MR_FALSE;
}
} else {
Index: library/time.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/time.m,v
retrieving revision 1.27
diff -u -b -r1.27 time.m
--- library/time.m 2002/06/14 10:18:55 1.27
+++ library/time.m 2002/07/16 13:50:25
@@ -189,7 +189,7 @@
:- mode time__c_clock(out, di, uo) is det.
:- pragma foreign_proc("C", time__c_clock(Ret::out, IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"{
Ret = (MR_Integer) clock();
update_io(IO0, IO);
@@ -239,7 +239,7 @@
:- pragma foreign_proc("C",
time__c_times(Ret::out, Ut::out, St::out, CUt::out,
CSt::out, IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"{
#ifdef MR_HAVE_POSIX_TIMES
struct tms t;
@@ -279,7 +279,7 @@
:- pragma foreign_proc("C",
time__c_time(Ret::out, IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"{
Ret = (MR_Integer) time(NULL);
update_io(IO0, IO);
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.43
diff -u -b -r1.43 mercury_trace_base.c
--- runtime/mercury_trace_base.c 2002/06/28 12:17:17 1.43
+++ runtime/mercury_trace_base.c 2002/07/17 16:32:45
@@ -116,6 +116,7 @@
MR_Unsigned MR_io_tabling_counter_hwm = 0;
MR_Unsigned MR_io_tabling_start = 0;
MR_Unsigned MR_io_tabling_end = 0;
+MR_bool MR_io_tabling_debug = MR_FALSE;
#ifdef MR_TRACE_HISTOGRAM
Index: runtime/mercury_trace_base.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_base.h,v
retrieving revision 1.24
diff -u -b -r1.24 mercury_trace_base.h
--- runtime/mercury_trace_base.h 2002/06/28 12:17:17 1.24
+++ runtime/mercury_trace_base.h 2002/07/17 16:34:25
@@ -170,6 +170,9 @@
/* The highest I/O action number which is to be tabled. */
extern MR_IoActionNum MR_io_tabling_end;
+/* The flag that controls whether we should generate diagnostics. */
+extern MR_bool MR_io_tabling_debug;
+
/*
** These functions will report the number of the last event,
** if there have been some events, and will do nothing otherwise.
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 tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
Index: tests/debugger/declarative/tabled_read_decl.m
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/tabled_read_decl.m,v
retrieving revision 1.1
diff -u -b -r1.1 tabled_read_decl.m
--- tests/debugger/declarative/tabled_read_decl.m 2002/05/15 11:24:17 1.1
+++ tests/debugger/declarative/tabled_read_decl.m 2002/07/17 15:59:10
@@ -129,7 +129,7 @@
:- pragma foreign_proc("C",
tabled_read_decl__write_int(N::in, IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure],
+ [will_not_call_mercury, promise_pure, tabled_for_io],
"{
printf(""%d\\n"", (int) N);
IO = IO0;
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/structure_reuse
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
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.129
diff -u -b -r1.129 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 2002/05/15 11:24:19 1.129
+++ trace/mercury_trace_internal.c 2002/07/17 16:35:14
@@ -3157,6 +3157,9 @@
MR_io_tabling_phase = MR_IO_TABLING_DURING;
MR_io_tabling_start = MR_io_tabling_counter;
MR_io_tabling_end = MR_IO_ACTION_MAX;
+#ifdef MR_DEBUG_RETRY
+ MR_io_tabling_debug = MR_TRUE;
+#endif
fprintf(MR_mdb_out, "io tabling started\n");
} else if (MR_io_tabling_phase == MR_IO_TABLING_DURING)
{
Index: trace/mercury_trace_util.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_util.h,v
retrieving revision 1.7
diff -u -b -r1.7 mercury_trace_util.h
--- trace/mercury_trace_util.h 2002/02/18 07:01:32 1.7
+++ trace/mercury_trace_util.h 2002/07/18 15:45:38
@@ -38,11 +38,16 @@
*/
#define MR_TRACE_CALL_MERCURY(STATEMENTS) do { \
+ MR_bool saved_io_enabled; \
+ \
+ saved_io_enabled = MR_io_tabling_enabled; \
+ MR_io_tabling_enabled = MR_FALSE; \
MR_restore_transient_registers(); \
MR_save_registers(); \
STATEMENTS; \
MR_restore_registers(); \
MR_save_transient_registers(); \
+ MR_io_tabling_enabled = saved_io_enabled; \
} while (0)
/*
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.46
diff -u -b -r1.46 mercury_trace_vars.c
--- trace/mercury_trace_vars.c 2002/06/28 12:17:21 1.46
+++ trace/mercury_trace_vars.c 2002/07/18 15:50:03
@@ -1,4 +1,7 @@
/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
** Copyright (C) 1999-2002 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -118,10 +121,8 @@
const void *arg2);
static const char * MR_trace_browse_one_path(FILE *out,
MR_Var_Spec var_spec, char *path,
- MR_Browser browser,
- MR_Browse_Caller_Type caller,
- MR_Browse_Format format,
- MR_bool must_be_unique);
+ MR_Browser browser, MR_Browse_Caller_Type caller,
+ MR_Browse_Format format, MR_bool must_be_unique);
static char * MR_trace_browse_var(FILE *out, MR_Var_Details *var,
char *path, MR_Browser browser,
MR_Browse_Caller_Type caller,
@@ -129,7 +130,8 @@
static char * MR_trace_var_completer_next(const char *word,
size_t word_len, MR_Completer_Data *data);
static const char * MR_trace_bad_path(const char *path);
-static int MR_trace_print_var_name(FILE *out, MR_Var_Details *var);
+static int MR_trace_print_var_name(FILE *out,
+ MR_Var_Details *var);
static const char * MR_trace_valid_var_number(int var_number);
#define MR_INIT_VAR_DETAIL_COUNT 20
@@ -332,8 +334,7 @@
entry = level_layout->MR_sll_entry;
if (! MR_PROC_LAYOUT_HAS_EXEC_TRACE(entry)) {
- return "this procedure does not have "
- "debugging information";
+ return "this procedure does not have debugging information";
}
if (! MR_has_valid_var_count(level_layout)) {
@@ -403,8 +404,7 @@
}
string_table = entry->MR_sle_module_layout->MR_ml_string_table;
- string_table_size =
- entry->MR_sle_module_layout->MR_ml_string_table_size;
+ string_table_size = entry->MR_sle_module_layout->MR_ml_string_table_size;
/* Work out how many type-infos were added. */
if (MR_PROC_LAYOUT_COMPILER_GENERATED(entry)) {
@@ -475,21 +475,17 @@
}
if (s == copy + copylen - 1) {
- MR_point.MR_point_vars[slot].MR_var_has_suffix =
- MR_FALSE;
+ MR_point.MR_point_vars[slot].MR_var_has_suffix = MR_FALSE;
/* num_suffix should not be used */
MR_point.MR_point_vars[slot].MR_var_num_suffix = -1;
MR_point.MR_point_vars[slot].MR_var_basename = copy;
} else {
if (MR_isdigit(*s)) {
- MR_fatal_error(
- "variable name starts with digit");
+ MR_fatal_error("variable name starts with digit");
}
- MR_point.MR_point_vars[slot].MR_var_has_suffix =
- MR_TRUE;
- MR_point.MR_point_vars[slot].MR_var_num_suffix
- = atoi(s + 1);
+ MR_point.MR_point_vars[slot].MR_var_has_suffix = MR_TRUE;
+ MR_point.MR_point_vars[slot].MR_var_num_suffix = atoi(s + 1);
*(s + 1) = '\0';
MR_point.MR_point_vars[slot].MR_var_basename = copy;
}
@@ -498,12 +494,10 @@
for (head_var_num = num_added_args;
head_var_num < entry->MR_sle_num_head_vars;
head_var_num++)
- {
- if (entry->MR_sle_head_var_nums[head_var_num]
- == var_num)
{
- MR_point.MR_point_vars[slot].MR_var_is_headvar
- = head_var_num - num_added_args + 1;
+ if (entry->MR_sle_head_var_nums[head_var_num] == var_num) {
+ MR_point.MR_point_vars[slot].MR_var_is_headvar =
+ head_var_num - num_added_args + 1;
break;
}
}
@@ -516,8 +510,7 @@
MR_free(type_params);
if (slot_max > 0) {
- qsort(MR_point.MR_point_vars, slot_max,
- sizeof(MR_Var_Details),
+ qsort(MR_point.MR_point_vars, slot_max, sizeof(MR_Var_Details),
MR_trace_compare_var_details);
slot = 1;
@@ -536,10 +529,8 @@
MR_point.MR_point_vars[slot].MR_var_fullname,
MR_point.MR_point_vars[slot-1].MR_var_fullname))
{
- MR_point.MR_point_vars[slot - 1].
- MR_var_is_ambiguous = MR_TRUE;
- MR_point.MR_point_vars[slot].
- MR_var_is_ambiguous = MR_TRUE;
+ MR_point.MR_point_vars[slot - 1].MR_var_is_ambiguous = MR_TRUE;
+ MR_point.MR_point_vars[slot].MR_var_is_ambiguous = MR_TRUE;
}
slot++;
@@ -685,10 +676,8 @@
for (i = 0; i < MR_point.MR_point_var_count; i++) {
if (MR_point.MR_point_vars[i].MR_var_hlds_number == hlds_num) {
- *type_info_ptr =
- MR_point.MR_point_vars[i].MR_var_type;
- *value_ptr =
- MR_point.MR_point_vars[i].MR_var_value;
+ *type_info_ptr = MR_point.MR_point_vars[i].MR_var_type;
+ *value_ptr = MR_point.MR_point_vars[i].MR_var_value;
return NULL;
}
}
@@ -785,6 +774,7 @@
int headvar_num;
int arity;
int slot;
+ MR_bool saved_io_tabling_enabled;
proc_layout = MR_point.MR_point_level_entry;
MR_generate_proc_name_from_layout(proc_layout, &proc_name, &arity,
@@ -802,7 +792,7 @@
*/
prev = MR_list_empty();
cur = arg_list;
- while (!MR_list_is_empty(cur) &&
+ while (! MR_list_is_empty(cur) &&
headvar_num > vars[MR_list_head(cur)].MR_var_is_headvar)
{
prev = cur;
@@ -848,7 +838,10 @@
}
);
+ saved_io_tabling_enabled = MR_io_tabling_enabled;
+ MR_io_tabling_enabled = MR_FALSE;
(*browser)(proc_name, arg_list, is_func, caller, format);
+ MR_io_tabling_enabled = saved_io_tabling_enabled;
return NULL;
}
@@ -860,6 +853,7 @@
MR_Word is_func;
MR_Word arg_list;
const char *problem;
+ MR_bool saved_io_tabling_enabled;
problem = MR_trace_get_action(action_number, &proc_name,
&is_func, &arg_list);
@@ -867,7 +861,10 @@
return problem;
}
+ saved_io_tabling_enabled = MR_io_tabling_enabled;
+ MR_io_tabling_enabled = MR_FALSE;
(*browser)(proc_name, arg_list, is_func, caller, format);
+ MR_io_tabling_enabled = saved_io_tabling_enabled;
return NULL;
}
@@ -992,9 +989,8 @@
success_count = 0;
do {
- bad_path = MR_trace_browse_var(out,
- &MR_point.MR_point_vars[i], path,
- browser, caller, format);
+ bad_path = MR_trace_browse_var(out, &MR_point.MR_point_vars[i],
+ path, browser, caller, format);
if (bad_path == NULL) {
success_count++;
@@ -1009,9 +1005,8 @@
return "the selected path does not exist in any of the variables with that name";
}
} else {
- bad_path = MR_trace_browse_var(out,
- &MR_point.MR_point_vars[i], path,
- browser, caller, format);
+ bad_path = MR_trace_browse_var(out, &MR_point.MR_point_vars[i],
+ path, browser, caller, format);
if (bad_path != NULL) {
return MR_trace_bad_path(bad_path);
}
@@ -1077,8 +1072,7 @@
return problem;
}
- return MR_trace_browse_all(out, MR_trace_print,
- MR_BROWSE_DEFAULT_FORMAT);
+ return MR_trace_browse_all(out, MR_trace_print, MR_BROWSE_DEFAULT_FORMAT);
}
static char *
@@ -1093,6 +1087,7 @@
char *old_path;
int arg_num;
int len;
+ MR_bool saved_io_tabling_enabled;
typeinfo = var->MR_var_type;
value = &var->MR_var_value;
@@ -1123,8 +1118,7 @@
saved_char = *path;
*path = '\0';
- if (! MR_named_arg_num(typeinfo, value,
- old_path, &arg_num))
+ if (! MR_named_arg_num(typeinfo, value, old_path, &arg_num))
{
*path = saved_char;
return old_path;
@@ -1170,7 +1164,10 @@
fflush(out);
}
+ saved_io_tabling_enabled = MR_io_tabling_enabled;
+ MR_io_tabling_enabled = MR_FALSE;
(*browser)((MR_Word) typeinfo, *value, caller, format);
+ MR_io_tabling_enabled = saved_io_tabling_enabled;
return NULL;
}
@@ -1182,8 +1179,7 @@
int offset;
string_table = entry->MR_sle_module_layout->MR_ml_string_table;
- string_table_size =
- entry->MR_sle_module_layout->MR_ml_string_table_size;
+ string_table_size = entry->MR_sle_module_layout->MR_ml_string_table_size;
if (hlds_var_num > entry->MR_sle_max_named_var_num) {
/* this value is a compiler-generated variable */
@@ -1245,7 +1241,8 @@
** argument number is part of the name.
*/
if (var->MR_var_is_headvar &&
- !MR_streq(var->MR_var_basename, "HeadVar__")) {
+ ! MR_streq(var->MR_var_basename, "HeadVar__"))
+ {
char buf[256]; /* this should be plenty big enough */
sprintf(buf, " (arg %d)", var->MR_var_is_headvar);
@@ -1262,6 +1259,7 @@
if (var_number < 1) {
return "invalid variable number";
}
+
if (var_number > MR_point.MR_point_var_count) {
return "there aren't that many variables";
}
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