[m-rev.] for review: remove support for old C interface
Julien Fischer
juliensf at csse.unimelb.edu.au
Thu Sep 9 18:19:42 AEST 2010
The main thing that needs to be reviewed here are the changes to the
reference manual. The changes to the compiler consist almost entirely
of deleting stuff.
===========================================================================
Remove support for the old C interface. The parser still recognises the old
pragmas but it now emits an error message saying what pragma in the "new"
foreign language interface to use instead. (That will be deleted after the
next release.)
Remove support for nondet foreign code from the implementation.
Add some bits from the old C interface chapter of the reference manual,
about linking with C object files and the c_pointer type, to the chapter
on the foreign language interface; delete the rest.
Add an illustration of simulating nondet foreign code with Mercury clauses
and (semi)deterministic foreign_procs.
doc/reference_manual.texi:
Delete the old C interface chapter.
Add a section on linking against C object files to the C specific
section of the foreign language interface chapter. (The old version of
this was quite mmake-specific, the new version attempts to minimise
this.)
Mention the c_pointer type in section on C foreign types.
Mention that nondet foreign_procs are not allowed. Give an example
to use foreign code and nondeterminism.
compiler/prog_io_pragma.m:
Emit error messages when any of the pragmas used by the old C interface
are encountered.
compiler/prog_item.m:
Delete the parse tree representation of import pragmas.
compiler/gcc.m:
Replace `:- pragma import' declarations with `:- pragma foreign_proc'
declarations for C.
compiler/add_heap_ops.m:
compiler/add_trail_ops.m:
compiler/add_pragma.m:
compiler/deep_profiling.m:
compiler/det_analysis.m:
compiler/equiv_type.m:
compiler/erl_call_gen.m:
compiler/foreign.m:
compiler/goal_util.m:
compiler/hlds_out_goal.m:
compiler/make_hlds_passes.m:
compiler/make_hlds_warn.m:
compiler/mercury_to_mercury.m
compiler/ml_code_gen.m:
compiler/module_qual.m:
compiler/modules.m:
compiler/polymorphism.m:
compiler/pragma_c_gen.m:
compiler/proc_gen.m:
compiler/prog_data.m:
compiler/recompilation.version.m:
Delete stuff related the old C interface.
tests/hard_coded_Mmakefile:
tests/hard_coded/inline_nondet_pragma_c.*:
tests/hard_coded/nondet_c.*:
tests/hard_coded/nondet_pragma_c_bug.*:
tests/hard_coded/pragma_import.*:
Delete these tests. The features they exercise are no longer
supported.
tests/*/*.m:
Replace uses of the old C interface with the new.
Julien.
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.448
diff -u -r1.448 reference_manual.texi
--- doc/reference_manual.texi 25 Aug 2010 01:05:34 -0000 1.448
+++ doc/reference_manual.texi 9 Sep 2010 08:04:15 -0000
@@ -102,8 +102,6 @@
programs.
* Foreign language interface:: Calling code written in other programming
languages from Mercury code
-* C interface:: The C interface allows C code to be called
- from Mercury code, and vice versa.
* Impurity:: Users can write impure Mercury code.
* Trace goals:: Trace goals allow programmers to add debugging and
logging code to their programs.
@@ -594,7 +592,7 @@
The @samp{type}, @samp{pred} and @samp{func} declarations are used for the
type system,
the @samp{inst} and @samp{mode} declarations are for the mode system,
-the @samp{pragma} declarations are for the C interface, and for
+the @samp{pragma} declarations are for the foreign language interface, and for
compiler hints about inlining, and the remainder are for the module system.
They are described in more detail in their respective chapters.
@@ -6464,15 +6462,10 @@
languages.
* Language specific bindings:: Information specific to each
foreign language.
+
@end menu
This chapter documents the foreign language interface.
-The current implementation also supports an old C interface for
-Mercury, which is documented in @ref{C interface}.
-Note that the old C interface is deprecated and will be removed in a
-future version.
-We recommend that code written using the old interface be updated to
-use the interface described in this chapter instead.
@node Calling foreign code from Mercury
@section Calling foreign code from Mercury
@@ -6537,7 +6530,6 @@
If there is a @code{pragma foreign_proc} declaration for any
mode of a predicate or function, then there must be either a
clause or a @code{pragma foreign_proc}
- at c or @code{pragma import}
declaration for every mode of that predicate or function.
Here's an example of code using @samp{pragma foreign_proc}:
@@ -6562,16 +6554,62 @@
a procedure and/or foreign_proc definitions for different languages,
it is implementation defined which definition is used.
-For pure and semipure procedures, the declarative semantics of the
-foreign_proc definitions must be the same as that of the Mercury code.
-The only thing that is allowed to differ is the efficiency (including
-the possibility of non-termination) and the order of solutions.
+For pure and semipure procedures, the declarative semantics of the foreign_proc
+definitions must be the same as that of the Mercury code.
+The only thing that is allowed to differ is the efficiency (including the
+possibility of non-termination) and the order of solutions.
+
+It is an error for a procedure with a @samp{pragma foreign_proc} declaration to
+have a determinism of @samp{multi} or @samp{nondet}.
+
+Since foreign_procs with the determinism @samp{multi} or @samp{nondet} cannot
+be defined directly, procedures with those determinisms that require foreign
+code in their implementation must be defined using a combination of Mercury
+clauses and (semi)deterministic foreign_procs.
+The following implementation for the standard library predicate
+ at samp{string.append/3} in the mode @samp{append(out, out, in) is multi}
+illustrates this technique:
+
+ at example
+:- pred append(string, string, string).
+:- mode append(out, out, in) is multi.
+
+append(S1, S2, S3) :-
+ S3Len = string.length(S3),
+ append_2(0, S3Len, S1, S2, S3).
+
+:- pred append_2(int::in, int::in, string::::out, string::out, string::in) is multi.
+
+append_2(NextS1Len, S3Len, S1, S2, S3) :-
+ ( NextS1Len = S3Len ->
+ append_3(NextS1Len, S3Len, S1, S2, S3)
+ ;
+ (
+ append_3(NextS1Len, S3Len, S1, S2, S3)
+ ;
+ append_2(NextS1Len + 1, S3Len, S1, S2, S3)
+ )
+ ).
+
+:- pred append_3(int::inb, int::in, string::out, string::out, string::in) is det.
+
+:- pragma foreign_proc("C",
+ append_3(S1Len::in, S3Len::in, S1::out, S2::out, S3::in),
+ [will_not_call_mercury, promise_pure],
+"
+ S1 = allocate_string(S1Len); /* Allocate a new string of length S1Len */
+ memcpy(S1, S3, S1Len);
+ S1[S1Len] = '\\0';
+ S2 = allocate_string(S2, S3Len - S1Len);
+ strcpy(S2, S3Len + S1Len);
+").
+
+ at end example
@node Foreign code attributes
@subsection Foreign code attributes
As described above,
- at c @samp{pragma import} and
@samp{pragma foreign_proc}
declarations may include a list of attributes describing properties
of the given foreign function or code.
@@ -6640,8 +6678,7 @@
allows safe declarative debugging of code containing such calls.
For more information see the I/O tabling section of the Mercury user guide.
If the foreign procedure contains gotos or static variables then the
- at samp{pragma no_inline} directive should also be given
-(see @ref{pragma c_code}).
+ at samp{pragma no_inline} directive should also be given.
Note that currently I/O tabling will only be done for foreign procedures
that take a pair of I/O state arguments. Impure foreign procedures that
perform I/O will not be made idempotent, even if the tabled_for_io
@@ -7568,6 +7605,9 @@
* Using pragma foreign_code for C :: Including C code in Mercury
* Memory management for C :: Caveats about passing dynamically
allocated memory to or from C.
+* Linking with C object files :: Linking with C object files and
+ libraries.
+
@end menu
@node Using pragma foreign_type for C
@@ -7612,10 +7652,51 @@
will use @var{CForeignType} as the type for any
parameters whose Mercury type is @var{MercuryTypeName}.
-Also see the section on using C pointers (@pxref{Using C pointers}) for
-information on how to use the c_pointer type with the C interface.
- at c XXX we should eventually just move that section to here,
- at c presenting it as an alternative to pragma foreign_type.
+The builtin Mercury type @code{c_pointer} may be used to pass C pointers
+between C functions which are called from Mercury. For example:
+
+ at example
+:- module pointer_example.
+:- interface.
+
+:- type complicated_c_structure.
+
+% Initialise the abstract C structure that we pass around in Mercury.
+:- pred initialise_complicated_structure(complicated_c_structure::uo) is det.
+
+% Perform a calculation on the C structure.
+:- pred do_calculation(int::in, complicated_c_structure::di,
+ complicated_c_structure::uo) is det.
+
+:- implementation.
+
+% Our C structure is implemented as a c_pointer.
+:- type complicated_c_structure
+ ---> complicated_c_structure(c_pointer).
+
+:- pragma foreign_decl("C",
+ extern struct foo *init_struct(void);
+ extern struct foo *perform_calculation(int, struct foo *);
+");
+
+:- pragma foreign_proc("C",
+ initialise_complicated_structure(Structure::uo),
+ [will_not_call_mercury, may_call_mercury],
+"
+ Structure = init_struct();
+").
+
+:- pragma foreign_proc("C",
+ do_calculation(Value::in, Structure0::di, Structure::uo),
+ [will_not_call_mercury, may_call_mercury],
+"
+ Structure = perform_calculation(Value, Structure0);
+").
+ at end example
+
+We strongly recommend the use of @samp{pragma foreign_type} instead of
+ at code{c_pointer} as the use of @samp{pragma foreign_type} results in
+more type-safe code.
@node Using pragma foreign_export_enum for C
@subsubsection Using pragma foreign_export_enum for C
@@ -7872,6 +7953,41 @@
methods of memory management, but more implementation experience is
needed before we can formulate such an interface.
+ at node Linking with C object files
+ at subsubsection Linking with C object files
+
+A Mercury implementation should allow you to link with object files or
+libraries that were produced by compiling C code.
+The exact mechanism for linking with C object files is
+implementation-dependent.
+The following text describes how it is done for the University of Melbourne
+Mercury implementation.
+
+To link an existing object file into your Mercury code, use the command line
+option @samp{--link-object}.
+For example, the following will link the object file @samp{my_function.o} from
+the current directory when compiling the program @samp{prog}:
+
+ at example
+mmc --link-object my_functions.o prog
+ at end example
+
+The command line option @samp{--library} (or @samp{-l} for short)
+can be used to link an existing library into your Mercury code.
+For example, the following will link the library file @samp{libfancy_library.a},
+or perhaps it shared version @samp{libfancy_library.so}, from the directory
+ at samp{/usr/local/contrib/lib}, when compiling the program @samp{prog}:
+
+ at example
+mmc -R/usr/local/contrib/lib -L/usr/local/contrib/lib --lfancy_library prog
+ at end example
+
+As illustred by the example, the command line options @samp{-R}, @samp{-L}
+and @samp{-l}, have the same meaning as they do with the Unix linker.
+
+For more information, see the ``Libraries'' chapter of the
+Mercury User's Guide.
+
@c ----------------------------------------------------------------------------
@node Interfacing with C#
@@ -8518,669 +8634,20 @@
@c ----------------------------------------------------------------------------
- at node C interface
- at chapter C interface
-
- at menu
-* Calling C code from Mercury:: How to implement a Mercury predicate
- or function as a call to C code.
-* Including C headers:: Using functions with prototypes from a
- non-standard header file.
-* Including C code:: Including definitions of C
- functions in your Mercury code.
-* Linking with C object files:: Linking with C object files and
- libraries.
-* Calling Mercury code from C:: How to export a Mercury function or
- predicate for use by C code.
-* Passing data to and from C:: Exchanging simple data types between
- Mercury and C.
-* Using C pointers:: Maintaining a reference to C data
- structures in Mercury code.
- at end menu
-
-This chapter documents the original C interface.
-It has been deprecated in favour of the of the new foreign language interface
-documented in @ref{Foreign language interface}.
-Support for this interface will be removed in a future version.
-
- at node Calling C code from Mercury
- at section Calling C code from Mercury
-
-There are two slightly different mechanisms for calling C code from Mercury:
- at samp{pragma import} and @samp{pragma c_code}. @samp{pragma import}
-allows you to call C functions from Mercury. @samp{pragma c_code}
-allows you to implement Mercury procedures using arbitrary fragments
-of C code. @samp{pragma import} is usually simpler, but
- at samp{pragma c_code} is a bit more flexible.
-
- at c
- at c We can't use "@samp" or even "`...'" in node names -- if we use
- at c either, then texi2dvi barfs. So the node names are
- at c e.g. "pragma import" rather than "@samp{pragma import}".
- at c
- at menu
-* pragma import:: Importing C functions.
-* pragma c_code:: Defining Mercury procedures using C code.
-* Nondet pragma c_code:: Using @samp{pragma c_code} for Mercury procedures
- that can have more than one solution.
-* C code attributes:: Describing properties of C functions or C code.
-* Purity and side effects:: Explains when side effects are allowed.
- at end menu
-
- at node pragma import
- at subsection pragma import
-
-A declaration of the form
-
- at example
-:- pragma import(@var{Pred}(@var{Mode1}, @var{Mode2}, @dots{}),
- @var{Attributes}, "@var{C_Name}").
- at end example
-
- at noindent
-or
-
- at example
-:- pragma import(@var{Func}(@var{Mode1}, @var{Mode2}, @dots{}) = @var{Mode},
- @var{Attributes}, "@var{C_Name}").
- at end example
-
- at noindent
-imports a C function for use by Mercury.
- at var{Pred} or @var{Func} must specify the name of a previously declared
-Mercury predicate or function, and @var{Mode1}, @var{Mode2}, @dots{},
-and (for functions) @var{Mode} must specify one of the
-modes of that predicate or function. There must be no clauses
-for the specified Mercury procedure; instead, any calls to that
-procedure will be executed by calling the C function named
- at var{C_Name}. The @var{Attributes} argument is optional; if present,
-it specifies properties of the given C function (@pxref{C code attributes}).
-
-For example, the following code imports the C function @samp{cos()}
-as the Mercury function @samp{cos/1}:
-
- at example
-:- func cos(float) = float.
-:- pragma import(cos(in) = out, [will_not_call_mercury], "cos").
- at end example
-
-The interface to the C function for a given Mercury procedure is
-determined as follows. Mercury types are converted to C types and
-passed according to the rules in @ref{Passing data to and from C}.
-
-If you use @samp{pragma import} for a polymorphically typed Mercury procedure,
-the compiler will prepend one @samp{type_info} argument to the parameters
-passed to the C function for each polymorphic type variable in the
-Mercury procedure's type signature. The values passed in these arguments
-will be the same as the values that would be obtained using the Mercury
- at samp{type_of} function in the Mercury standard library module @samp{type_desc}.
-These values may be useful in case the C function wishes to in turn call
-another polymorphic Mercury procedure (@pxref{Calling Mercury code from C}).
-
-You may not give a @samp{pragma import} declaration for a procedure
-with determinism @samp{nondet} or @samp{multi}.
-(It is however possible to define a @samp{nondet} or @samp{multi} procedure
-using @samp{pragma c_code}. @xref{Nondet pragma c_code}.)
-
- at node pragma c_code
- at subsection pragma c_code
-
-A declaration of the form
-
- at example
-:- pragma c_code(@var{Pred}(@var{Var1}::@var{Mode1}, @var{Var2}::@var{Mode2}, @dots{}),
- @var{Attributes}, @var{C_Code}).
- at end example
-
- at noindent
-or
-
- at example
-:- pragma c_code(@var{Func}(@var{Var1}::@var{Mode1}, @var{Var2}::@var{Mode2}, @dots{}) = (@var{Var}::@var{Mode}),
- @var{Attributes}, @var{C_Code}).
- at end example
-
- at noindent
-means that any calls to the specified mode of @var{Pred} or @var{Func}
-will result in execution of the C code given in @var{C_Code}.
-The C code fragment may refer to the specified variables
-(@var{Var1}, @var{Var2}, @dots{}, and @var{Var})
-directly by name. These variables will have C types corresponding
-to their Mercury types, as determined by the rules specified in
- at ref{Passing data to and from C}. It is an error for a variable
-to occur more than once in the argument list.
-
-The C code fragment may declare local variables, but it should not
-declare any labels or static variables unless there is also a Mercury
- at samp{pragma no_inline} declaration (@pxref{Inlining}) for the procedure.
-The reason for this is that otherwise the Mercury implementation may
-inline the procedure by duplicating the C code fragment for each call.
-If the C code fragment declared a static variable, inlining it in this
-way could result in the program having multiple instances of the static
-variable, rather than a single shared instance. If the C code fragment
-declared a label, inlining it in this way could result in an error due
-to the same label being defined twice inside a single C function.
-
-If there is a @code{pragma import} or @code{pragma c_code} declaration for a
-mode of a predicate or function, then there must not be any clauses for that
-predicate or function, and there must be a @code{pragma c_code}
-or @code{pragma import} declaration for every mode of the predicate or function.
-
-For example, the following piece of code defines a Mercury function
- at samp{sin/1} which calls the C function @samp{sin()} of the same name.
-
- at example
-:- func sin(float) = float.
-:- pragma c_code(sin(X::in) = (Sin::out),
- [may_call_mercury],
- "Sin = sin(X);").
- at end example
-
-If the C code does not recursively invoke Mercury code,
-as in the above example, then you can use @samp{will_not_call_mercury}
-in place of @samp{may_call_mercury} in the declarations above.
-This allows the compiler to use a slightly more efficient calling convention.
-(If you use this form, and the C code @emph{does} invoke Mercury code,
-then the behaviour is undefined --- your program may misbehave or crash.)
-
-The C code in a @code{pragma c_code} declaration
-for any procedure whose determinism indicates that it can fail
-must assign a truth value to the macro @samp{SUCCESS_INDICATOR}.
-For example:
-
- at example
-:- pred string.contains_char(string, character).
-:- mode string.contains_char(in, in) is semidet.
-
-:- pragma c_code(string.contains_char(Str::in, Ch::in),
- [will_not_call_mercury],
- "SUCCESS_INDICATOR = (strchr(Str, Ch) != NULL);").
- at end example
-
- at code{SUCCESS_INDICATOR} should not be used other than as the target of
-an assignment.
-(For example, it may be @code{#define}d to a register, so you should not
-try to take its address.)
-Procedures whose determinism indicates that they cannot fail
-should not access @code{SUCCESS_INDICATOR}.
-
-Arguments whose mode is input will have their values set by the
-Mercury implementation on entry to the C code. If the procedure
-succeeds, the C code must set the values of all output arguments.
-If the procedure fails, the C code need only
-set @code{SUCCESS_INDICATOR} to false (zero).
-
- at node Nondet pragma c_code
- at subsection Nondet pragma c_code
-
-For procedures that can return more than one result on backtracking,
-i.e.@: those with determinism @samp{nondet} or @samp{multi},
-the form of @samp{pragma c_code} declaration described previously
-does not suffice. Instead, you should use a declaration of the form
-shown below:
-
- at example
-:- pragma c_code(@var{Pred}(@var{Var1}::@var{Mode1}, @var{Var2}::@var{Mode2}, @dots{}),
- @var{Attributes}, local_vars(@var{LocalVars}), first_code(@var{FirstCode}),
- retry_code(@var{RetryCode}), common_code(@var{CommonCode})).
- at end example
-
- at noindent
-or
-
- at example
-:- pragma c_code(@var{Func}(@var{Var1}::@var{Mode1}, @var{Var2}::@var{Mode2}, @dots{}) = (@var{Var}::@var{Mode}),
- @var{Attributes}, local_vars(@var{LocalVars}), first_code(@var{FirstCode}),
- retry_code(@var{RetryCode}), common_code(@var{CommonCode})).
- at end example
-
- at noindent
-Here @var{FirstCode}, @var{RetryCode}, and @var{CommonCode} are all
-Mercury strings containing C code.
- at var{FirstCode} will be executed whenever the Mercury procedure is called.
- at var{RetryCode} will be executed whenever a given call to the procedure
-is re-entered on backtracking to find subsequent solutions.
-The @samp{common_code(@var{CommonCode})} argument is optional; if present,
- at var{CommonCode} will be executed after each execution of
- at var{FirstCode} or @var{RetryCode}.
-
-The code that is executed on each call or retry should finish by
-executing one of the three macros @samp{FAIL}, @samp{SUCCEED}, or
- at samp{SUCCEED_LAST}. The @samp{FAIL} macro indicates that the call has
-failed; the call will not be retried. The @samp{SUCCEED} macro
-indicates that the call has succeeded, and that there may be more
-solutions; the call may be retried on backtracking. The
- at samp{SUCCEED_LAST} macro indicates that the call has succeeded, but
-that there are no more solutions after this one; the call will not be
-retried.
-
- at var{LocalVars} is a sequence of struct member declarations which are
-used to hold any state which needs to be preserved in case of backtracking
-or passed between the different C code fragments.
-The code fragments @var{FirstCode}, @var{RetryCode}, and @var{CommonCode}
-may use the macro @samp{LOCALS}, which is defined to be a pointer to a struct
-containing the fields specified by @var{LocalVars}, to access this saved state.
-
-Note @var{RetryCode} and @var{CommonCode} may not access the input
-variables --- only @var{FirstCode} should access the input variables.
-If @var{RetryCode} or @var{CommonCode} need to access any of the input
-variables, then @var{FirstCode} should copy the values needed to the
- at var{LocalVars}.
-
-The following example shows how you can use a state variable to
-keep track of the next alternative to return.
-
- at example
-%
-% This example implements the equivalent of
-% foo(X) :- X = 20 ; X = 10 ; X = 42 ; X = 99 ; fail.
-%
-:- pred foo(int).
-:- mode foo(out) is multi.
-:- pragma c_code(foo(X::out), [will_not_call_mercury, thread_safe],
- local_vars("
- int state;
- "),
- first_code("
- LOCALS->state = 1;
- "),
- retry_code("
- LOCALS->state++;
- "),
- common_code("
- switch (LOCALS->state) @{
- case 1: X = 20; SUCCEED; break;
- case 2: X = 10; SUCCEED; break;
- case 3: X = 42; SUCCEED; break;
- case 4: X = 99; SUCCEED; break;
- case 5: FAIL; break;
- @}
- ")
-).
- at end example
-
- at noindent
-The next example is a more realistic example;
-it shows how you could implement the reverse
-mode of @samp{string.append}, which returns
-all possible ways of splitting a string into
-two pieces, using @samp{pragma c_code}.
-
- at example
-:- pred string.append(string, string, string).
-:- mode string.append(out, out, in) is multi.
-:- pragma c_code(string.append(S1::out, S2::out, S3::in),
- [will_not_call_mercury, thread_safe],
- local_vars("
- String s;
- size_t len;
- size_t count;
- "),
- first_code("
- LOCALS->s = S3;
- LOCALS->len = strlen(S3);
- LOCALS->count = 0;
- "),
- retry_code("
- LOCALS->count++;
- "),
- common_code("
- S1 = copy_substring(LOCALS->s, 0, LOCALS->count);
- S2 = copy_substring(LOCALS->s, LOCALS->count,
- LOCALS->len);
- if (LOCALS->count < LOCALS->len) @{
- SUCCEED;
- @} else @{
- SUCCEED_LAST;
- @}
- ")
-).
- at end example
-
- at node C code attributes
- at subsection C code attributes
-
-As described above, @samp{pragma import} and @samp{pragma c_code}
-declarations may include a list of attributes describing properties
-of the given C function or C code.
-All Mercury implementations must support the attributes listed below.
-They may also support additional attributes.
-
-The attributes which must be supported by all implementations
-are as follows:
-
- at table @asis
-
- at item @samp{may_call_mercury}/@samp{will_not_call_mercury}
-This attribute declares whether or not execution inside this C code may
-call back into Mercury or not. The default, in case neither is specified,
-is @samp{may_call_mercury}. Specifying @samp{will_not_call_mercury}
-may allow the compiler to generate more efficient code.
-If you specify @samp{will_not_call_mercury},
-but the C code @emph{does} invoke Mercury code, then the behaviour is
-undefined.
-
- at item @samp{thread_safe}/@samp{not_thread_safe}
-This attribute declares whether or not it is safe for multiple threads
-to execute this C code concurrently.
-The default, in case neither is specified, is @samp{not_thread_safe}.
-If the C code is declared @samp{thread_safe}, then the Mercury implementation
-is permitted to execute the code concurrently from multiple threads without
-taking any special precautions. If the C code is declared
- at samp{not_thread_safe},
-then the Mercury implementation must not invoke the code concurrently from
-multiple threads. If the Mercury implementation does use multithreading,
-then it must take appropriate steps to prevent this.
-(The experimental multithreaded version of the current
-University of Melbourne Mercury implementation protects
- at samp{not_thread_safe} code using a mutex:
-C code that is not thread-safe has code inserted around it to obtain
-and release a mutex. All non-thread-safe C code shares a single mutex.)
- at c XXX this can cause deadlocks if not_thread_safe C code calls
- at c Mercury which calls C
-
- at end table
-
- at node Purity and side effects
- at subsection Purity and side effects
-
-Note that procedures implemented in C using either
- at samp{pragma import} or @samp{pragma c_code} must still be ``pure'',
-unless declared otherwise (@pxref{Impurity}), and they must
-be type-correct and mode-correct. (Determinism-correctness
-is also required, but it follows from the rules already stated
-above.) Pure or semipure procedures may perform destructive update on their
-arguments only if those arguments have an appropriate
-unique mode declaration.
-Impure predicates may perform destructive update on data pointed to by
-C pointer arguments, even without unique modes. But they cannot
-destructively update the arguments themselves.
-Procedures may perform I/O only if their arguments
-include an @samp{io.state} pair (see the @samp{io} chapter
-of the Mercury Library Reference Manual), or if they are declared impure
-(@pxref{Impurity}).
-The Mercury implementation is allowed to assume that
-these rules are followed, and to optimize accordingly.
-If the C code is not type-correct, mode-correct,
-determinism-correct, and purity-correct with respect
-to its Mercury declaration, then the behaviour is
-undefined.
-
-For example, the following code defines a predicate
- at samp{c_write_string/3}, which has a similar effect to
-the Mercury library predicate @samp{io.write_string/3}:
-
- at example
-:- pred c_write_string(string, io.state, io.state).
-:- mode c_write_string(in, di, uo) is det.
-
-:- pragma c_code(c_write_string(S::in, IO0::di, IO::uo),
- [may_call_mercury],
- "puts(S); IO = IO0;").
- at end example
-
- at noindent
-In this example, the I/O is done via side effects inside the C code,
-but the Mercury interface includes @samp{io.state} arguments
-to ensure that the predicate has a proper declarative
-semantics. If the @samp{io.state} arguments were
-left off, then the Mercury implementation might apply
-undesirable optimizations (e.g.@: reordering, duplicate
-call elimination, tabling, lazy evaluation, @dots{})
-to this procedure, which could effect the behaviour
-of the program in unpredictable ways.
-
-Impure C code relaxes some of these restrictions.
-Impure C code may perform I/O and although it cannot update its
-arguments directly (unless they have an appropriate unique mode, e.g.@:
- at samp{di}) it may update something pointed to by its arguments.
-Impure C code procedures must still be type correct and mode correct.
-
- at node Including C headers
- at section Including C headers
-
-Any macros, function prototypes, or other C declarations
-that are used in @samp{c_code} pragmas must be included using a
- at samp{c_header_code} declaration of the form
-
- at example
-:- pragma c_header_code(@var{HeaderCode}).
- at end example
-
- at noindent
- at var{HeaderCode} can be a C @samp{#include} line, for example
-
- at example
-:- pragma c_header_code("#include <math.h>")
- at end example
-
- at noindent
-or
-
- at example
-:- pragma c_header_code("#include ""tcl.h""").
- at end example
-
- at noindent
-or it may contain any C declarations, for example
-
- at example
-:- pragma c_header_code("
- extern int errno;
- #define SIZE 200
- struct Employee @{
- char name[SIZE];
- @}
- extern int bar;
- extern void foo(void);
-").
- at end example
-
-Mercury automatically includes certain headers such as @code{<stdlib.h>},
-but you should not rely on this, as the set of headers which Mercury
-automatically includes is subject to change.
-
- at node Including C code
- at section Including C code
-
-Definitions of C functions or global variables may be
-included using a declaration of the form
-
- at example
-:- pragma c_code(@var{Code}).
- at end example
-
-For example,
-
- at example
-:- pragma c_code("
- int bar = 42;
- void foo(void) @{@}
-").
- at end example
-
-Such code is copied verbatim into the generated C file.
-
- at node Calling Mercury code from C
- at section Calling Mercury code from C
-
-It is also possible to export Mercury procedures to C,
-so that you can call Mercury code from C (or from
-other languages that can interface to C, e.g.@: C++).
-
-A declaration of the form
-
- at example
-:- pragma export(@var{Pred}(@var{Mode1}, @var{Mode2}, @dots{}), "@var{C_Name_1}").
- at end example
-
- at noindent
-or
-
- at example
-:- pragma export(@var{Func}(@var{Mode1}, @var{Mode2}, @dots{}) = @var{Mode}, "@var{C_Name_2}").
- at end example
-
- at noindent
-exports a procedure for use by C.
-
-For each Mercury module containing @samp{pragma export} declarations,
-the Mercury implementation will automatically create a header file
-for that module which declares a C function @var{C_Name}()
-for each of the @samp{pragma export} declarations.
-Each such C function is the C interface to the specified mode of
-the specified Mercury predicate or function.
-
-The interface to a Mercury procedure is determined as follows.
-(The rules here are just the converse of the rules for @samp{pragma import}).
-Mercury types are converted to C types according to the rules in
- at ref{Passing data to and from C}.
-Input arguments are passed by value. For output arguments, the
-caller must pass the address in which to store the result.
-If the Mercury procedure can fail, then its C interface function
-returns a truth value indicating success or failure.
-If the Mercury procedure is a Mercury function that cannot fail, and
-the function result has an output mode, then the C interface
-function will return the Mercury function result value.
-Otherwise the function result is appended as an extra argument.
-Arguments of type @samp{io.state} or @samp{store.store(_)}
-are not passed at all. (The reason for this is that these types
-represent mutable state, and in C modifications to mutable state
-are done via side effects, rather than argument passing.)
-
-Calling polymorphically typed Mercury procedures from C is a little bit
-more difficult than calling ordinary (monomorphically typed) Mercury procedures.
-The simplest method is to just create monomorphic forwarding
-procedures that call the polymorphic procedures, and export them,
-rather than exporting the polymorphic procedures.
-
-If you do export a polymorphically typed Mercury procedure, the compiler
-will prepend one @samp{type_info} argument to the parameter list of
-the C interface function for each polymorphic type variable in the
-Mercury procedure's type signature. The caller must arrange to pass
-in appropriate @samp{type_info} values corresponding to the types
-of the other arguments passed. These @samp{type_info} arguments can
-be obtained using the Mercury @samp{type_of} function in the Mercury
-standard library module @samp{type_desc}.
-
-It is an error to export Mercury procedures that have a determinism
-of multi or nondet to C.
-
-To use the C declarations produced for @samp{pragma export} declarations
-in C code within a Mercury module, use a @samp{pragma c_import_module}
-declaration, for example
-
- at example
-:- pragma c_import_module(imported_module).
- at end example
-
-This is equivalent to
-
- at example
-:- pragma c_header_code("#include ""imported_module.h""").
- at end example
-
- at noindent
-but it tells the implementation that the object file for the
-module containing the @samp{pragma c_import_module} declaration
-should not be built before @file{imported_module.h} is built.
-
- at node Linking with C object files
- at section Linking with C object files
-
-A Mercury implementation should allow you to link with
-object files or libraries that were produced by compiling C code.
-The exact mechanism for linking with C object files is
-implementation-dependent. The following text describes how
-it is done for the University of Melbourne Mercury implementation.
-
-To link an existing object file into your Mercury code,
-set the @samp{Mmake} variable @samp{MLOBJS} in the
- at samp{Mmake} file in the directory in which you are working.
-To link an existing library into your Mercury code,
-set the @samp{Mmake} variable @samp{MLLIBS}.
-For example, the following will link in the object file
- at samp{my_functions.o} from the current directory and
-the library file @samp{libfancy_library.a}, or perhaps its
-shared version @samp{fancy_library.so}, from the directory
- at samp{/usr/local/contrib/lib}.
-
- at example
-MLOBJS = my_functions.o
-MLFLAGS = -R/usr/local/contrib/lib -L/usr/local/contrib/lib
-MLLIBS = -lfancy_library
- at end example
-
-As illustrated by the example, the values for @samp{MLFLAGS} and
- at samp{MLLIBS} variables are similar to those taken by the Unix linker.
-
-For more information, see the ``Libraries'' chapter of the
-Mercury User's Guide, and the @samp{man} pages for @samp{mmc} and @samp{ml}.
-
- at node Passing data to and from C
- at section Passing data to and from C
-
-This is documented in @ref{C data passing conventions}.
-
- at node Using C pointers
- at section Using C pointers
-
-The inbuilt Mercury type @code{c_pointer} can be used to pass C pointers
-between C functions which are called from Mercury. For example:
-
- at example
-:- module pointer_example.
-
-:- interface.
-
-:- type complicated_c_structure.
-
-% Initialise the abstract C structure that we pass around in Mercury.
-:- pred initialise_complicated_structure(complicated_c_structure::uo) is det.
-
-% Perform a calculation on the C structure.
-:- pred do_calculation(int::in, complicated_c_structure::di,
- complicated_c_structure::uo) is det.
-
-:- implementation.
-
-% Our C structure is implemented as a c_pointer.
-:- type complicated_c_structure --->
- complicated_c_structure(c_pointer).
-
-:- pragma c_header_code("
- extern struct foo *init_struct(void);
- extern struct foo *perform_calculation(int, struct foo *);
-");
-
-:- pragma c_code(initialise_complicated_structure(Structure::uo),
- [may_call_mercury],
- "Structure = init_struct();").
-
-:- pragma c_code(do_calculation(Value::in, Structure0::di, Structure::uo),
- [may_call_mercury],
- "Structure = perform_calculation(Value, Structure0);").
- at end example
-
-We strong recommend the use of @samp{pragma foreign_type} instead of
- at code{c_pointer} as the use of @samp{pragma foreign_type} results in
-more type-safe code. (@pxref{Using pragma foreign_type for C}.)
-
-
@node Impurity
@chapter Impurity declarations
In order to efficiently implement certain predicates, it is occasionally
-necessary to venture outside pure logic programming. Other predicates
-cannot be implemented at all within the paradigm of logic programming,
-for example, all solutions predicates. Such predicates are often
-written using the C interface. Sometimes, however, it would be more
-convenient, or more efficient, to write such predicates using the
-facilities of Mercury. For example, it is much more convenient to
-access arguments of compound Mercury terms in Mercury than in C, and the
-ability of the Mercury compiler to specialize code can make higher-order
-predicates written in Mercury significantly more efficient than similar
-C code.
+necessary to venture outside pure logic programming.
+Other predicates cannot be implemented at all within the paradigm of logic
+programming, for example, all solutions predicates.
+Such predicates are often written using the foreign language interface.
+Sometimes, however, it would be more convenient, or more efficient, to write
+such predicates using the facilities of Mercury.
+For example, it is much more convenient to access arguments of compound Mercury
+terms in Mercury than in C, and the ability of the Mercury compiler to
+specialize code can make higher-order predicates written in Mercury
+significantly more efficient than similar C code.
One important aim of Mercury's impurity system is to make the
distinction between the pure and impure code very clear. This is done
@@ -9794,9 +9261,9 @@
@node Pragmas
@chapter Pragmas
-The pragma declarations described below are a standard part of the
-Mercury language, as are the pragmas for controlling the C interface
-(@pxref{C interface}) and impurity (@pxref{Impurity}).
+The pragma declarations described below are a standard part of the Mercury
+language, as are the pragmas for controlling the foreign language interface
+(@pxref{Foreign language interface}) and impurity (@pxref{Impurity}).
As an extension, implementations may also choose to support additional
pragmas with implementation-dependent semantics
(@pxref{Implementation-dependent extensions}).
Index: compiler/add_heap_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_heap_ops.m,v
retrieving revision 1.42
diff -u -r1.42 add_heap_ops.m
--- compiler/add_heap_ops.m 8 Sep 2009 02:43:31 -0000 1.42
+++ compiler/add_heap_ops.m 23 Aug 2010 07:27:34 -0000
@@ -232,28 +232,8 @@
),
Goal = hlds_goal(GoalExpr0, GoalInfo0)
;
- GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, Impl),
- (
- Impl = fc_impl_model_non(_, _, _, _, _, _, _, _, _),
- % XXX Implementing heap reclamation for nondet pragma foreign_code
- % via transformation is difficult, because there's nowhere in the
- % HLDS pragma_foreign_code goal where we can insert the heap
- % reclamation operations. For now, we don't support this. Instead,
- % we just generate a call to a procedure which will at runtime
- % call error/1 with an appropriate "Sorry, not implemented"
- % error message.
- ModuleInfo = !.Info ^ heap_module_info,
- Context = goal_info_get_context(GoalInfo0),
- heap_generate_call("reclaim_heap_nondet_pragma_foreign_code",
- detism_erroneous, purity_pure, [], instmap_delta_bind_no_var,
- ModuleInfo, Context, SorryNotImplementedCode),
- Goal = SorryNotImplementedCode
- ;
- ( Impl = fc_impl_ordinary(_, _)
- ; Impl = fc_impl_import(_, _, _, _)
- ),
- Goal = hlds_goal(GoalExpr0, GoalInfo0)
- )
+ GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
+ Goal = hlds_goal(GoalExpr0, GoalInfo0)
;
GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.104
diff -u -r1.104 add_pragma.m
--- compiler/add_pragma.m 30 Jul 2010 05:16:07 -0000 1.104
+++ compiler/add_pragma.m 30 Aug 2010 06:44:50 -0000
@@ -78,21 +78,6 @@
module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
- % module_add_pragma_import:
- %
- % Handles `pragma import' declarations, by figuring out which predicate
- % the `pragma import' declaration applies to, and adding a clause
- % for that predicate containing an appropriate HLDS `foreign_proc' goal.
- %
- % NB. Any changes here might also require similar changes to the
- % handling of `pragma foreign_export' declarations, in export.m.
- %
-:- pred module_add_pragma_import(sym_name::in, pred_or_func::in,
- list(mer_mode)::in, pragma_foreign_proc_attributes::in, string::in,
- import_status::in, prog_context::in,
- module_info::in, module_info::out, qual_info::in, qual_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
:- pred module_add_pragma_foreign_proc(pragma_foreign_proc_attributes::in,
sym_name::in, pred_or_func::in, list(pragma_var)::in, prog_varset::in,
inst_varset::in, pragma_foreign_code_impl::in, import_status::in,
@@ -259,10 +244,6 @@
add_pred_marker("obsolete", Name, Arity, ImportStatus,
Context, marker_obsolete, [], !ModuleInfo, !Specs)
;
- % Handle pragma import decls later on (when we process
- % clauses and pragma c_code).
- Pragma = pragma_import(_, _, _, _, _)
- ;
% Handle pragma foreign_export decls later on, after default
% function modes have been added.
Pragma = pragma_foreign_export(_, _, _, _, _)
@@ -2123,129 +2104,6 @@
% !Specs
).
-module_add_pragma_import(PredName, PredOrFunc, Modes, Attributes, C_Function,
- Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
- module_info_get_name(!.ModuleInfo, ModuleName),
- list.length(Modes, Arity),
-
- module_info_get_globals(!.ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
- (
- VeryVerbose = yes,
- trace [io(!IO)] (
- io.write_string("% Processing `:- pragma import' for ", !IO),
- write_simple_call_id(PredOrFunc, PredName/Arity, !IO),
- io.write_string("...\n", !IO)
- )
- ;
- VeryVerbose = no
- ),
-
- % Lookup the pred declaration in the predicate table. (If it's not there,
- % print an error message and insert a dummy declaration for the predicate.)
- module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
- (
- predicate_table_search_pf_sym_arity(PredicateTable0,
- is_fully_qualified, PredOrFunc, PredName, Arity, [PredId0])
- ->
- PredId = PredId0
- ;
- preds_add_implicit_report_error(ModuleName, PredOrFunc,
- PredName, Arity, Status, no, Context, origin_user(PredName),
- "`:- pragma import' declaration", PredId, !ModuleInfo, !Specs)
- ),
- % Lookup the pred_info for this pred, and check that it is valid.
- module_info_get_predicate_table(!.ModuleInfo, PredicateTable2),
- predicate_table_get_preds(PredicateTable2, Preds0),
- map.lookup(Preds0, PredId, PredInfo0),
- % Opt_imported preds are initially tagged as imported and are tagged as
- % opt_imported only if/when we see a clause (including a `pragma import'
- % clause) for them.
- ( Status = status_opt_imported ->
- pred_info_set_import_status(status_opt_imported, PredInfo0, PredInfo1)
- ;
- PredInfo1 = PredInfo0
- ),
- ( pred_info_is_imported(PredInfo1) ->
- Pieces = [words("Error: `:- pragma import' declaration for imported"),
- simple_call(simple_call_id(PredOrFunc, PredName, Arity)),
- suffix("."), nl],
- Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
- !:Specs = [Spec | !.Specs]
- ; pred_info_clause_goal_type(PredInfo1) ->
- module_info_incr_errors(!ModuleInfo),
- Pieces = [words("Error: `:- pragma import' declaration for"),
- simple_call(simple_call_id(PredOrFunc, PredName, Arity)),
- words("with preceding clauses."), nl],
- Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
- !:Specs = [Spec | !.Specs]
- ;
- pred_info_update_goal_type(goal_type_foreign, PredInfo1, PredInfo2),
- % Add the pragma declaration to the proc_info for this procedure.
- pred_info_get_procedures(PredInfo2, Procs),
- map.to_assoc_list(Procs, ExistingProcs),
- (
- get_procedure_matching_argmodes(ExistingProcs, Modes,
- !.ModuleInfo, ProcId)
- ->
- pred_add_pragma_import(PredId, ProcId, Attributes, C_Function,
- Context, PredInfo2, PredInfo, !ModuleInfo, !QualInfo, !Specs),
- map.det_update(Preds0, PredId, PredInfo, Preds),
- predicate_table_set_preds(Preds,
- PredicateTable2, PredicateTable),
- module_info_set_predicate_table(PredicateTable, !ModuleInfo)
- ;
- Pieces = [words("Error: `:- pragma import' declaration"),
- words("for undeclared mode of"),
- simple_call(simple_call_id(PredOrFunc, PredName, Arity)),
- suffix("."), nl],
- Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
- !:Specs = [Spec | !.Specs]
- )
- ).
-
- % Pred_add_pragma_import is a subroutine of module_add_pragma_import
- % which adds the c_code for a `pragma import' declaration to a pred_info.
- %
-:- pred pred_add_pragma_import(pred_id::in, proc_id::in,
- pragma_foreign_proc_attributes::in, string::in, prog_context::in,
- pred_info::in, pred_info::out, module_info::in, module_info::out,
- qual_info::in, qual_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
-pred_add_pragma_import(PredId, ProcId, Attributes, C_Function, Context,
- !PredInfo, !ModuleInfo, !QualInfo, !Specs) :-
- pred_info_get_procedures(!.PredInfo, Procs),
- map.lookup(Procs, ProcId, ProcInfo),
- foreign.make_pragma_import(!.PredInfo, ProcInfo, C_Function, Context,
- PragmaImpl, VarSet, PragmaVars, ArgTypes, Arity, PredOrFunc,
- !ModuleInfo, !Specs),
-
- % Lookup some information we need from the pred_info and proc_info.
- PredName = pred_info_name(!.PredInfo),
- PredModule = pred_info_module(!.PredInfo),
- pred_info_get_purity(!.PredInfo, Purity),
- pred_info_get_markers(!.PredInfo, Markers),
-
- pred_info_get_clauses_info(!.PredInfo, ClausesInfo0),
- ItemNumbers0 = ClausesInfo0 ^ cli_item_numbers,
- add_clause_item_number(no, Context, item_is_foreign_proc,
- ItemNumbers0, ItemNumbers),
- ClausesInfo1 = ClausesInfo0 ^ cli_item_numbers := ItemNumbers,
-
- % Add the code for this `pragma import' to the clauses_info.
- clauses_info_add_pragma_foreign_proc(pragma_import_foreign_proc,
- Purity, Attributes, PredId, ProcId,
- VarSet, PragmaVars, ArgTypes, PragmaImpl, Context,
- PredOrFunc, qualified(PredModule, PredName), Arity, Markers,
- ClausesInfo1, ClausesInfo, !ModuleInfo, !Specs),
-
- % Store the clauses_info etc. back into the pred_info.
- pred_info_set_clauses_info(ClausesInfo, !PredInfo).
-
%-----------------------------------------------------------------------------%
module_add_pragma_foreign_proc(Attributes0, PredName, PredOrFunc, PVars,
Index: compiler/add_trail_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_trail_ops.m,v
retrieving revision 1.54
diff -u -r1.54 add_trail_ops.m
--- compiler/add_trail_ops.m 8 Sep 2009 02:43:31 -0000 1.54
+++ compiler/add_trail_ops.m 23 Aug 2010 07:28:04 -0000
@@ -341,27 +341,8 @@
),
Goal = hlds_goal(GoalExpr0, GoalInfo0)
;
- GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, Impl),
- (
- Impl = fc_impl_model_non(_, _, _, _, _, _, _, _, _),
- % XXX Implementing trailing for nondet pragma foreign_code via
- % transformation is difficult, because there's nowhere in the HLDS
- % pragma_foreign_code goal where we can insert trailing operations.
- % For now, we don't support this. Instead, we just generate a call
- % to a procedure which will at runtime call error/1 with an
- % appropriate "Sorry, not implemented" error message.
- ModuleInfo = !.Info ^ trail_module_info,
- Context = goal_info_get_context(GoalInfo0),
- trail_generate_call("trailed_nondet_pragma_foreign_code",
- detism_erroneous, purity_pure, [], instmap_delta_bind_no_var,
- ModuleInfo, Context, SorryNotImplementedCode),
- Goal = SorryNotImplementedCode
- ;
- ( Impl = fc_impl_ordinary(_, _)
- ; Impl = fc_impl_import(_, _, _, _)
- ),
- Goal = hlds_goal(GoalExpr0, GoalInfo0)
- )
+ GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
+ Goal = hlds_goal(GoalExpr0, GoalInfo0)
;
GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.104
diff -u -r1.104 deep_profiling.m
--- compiler/deep_profiling.m 30 Jul 2010 05:16:09 -0000 1.104
+++ compiler/deep_profiling.m 23 Aug 2010 07:20:54 -0000
@@ -496,16 +496,8 @@
deep_prof_maybe_transform_proc(ModuleInfo, PredId, ProcId, !ProcTable) :-
map.lookup(!.ProcTable, ProcId, ProcInfo0),
- proc_info_get_goal(ProcInfo0, Goal0),
PredModuleName = predicate_module(ModuleInfo, PredId),
(
- % XXX We need to eliminate nondet C code...
- Goal0 = hlds_goal(call_foreign_proc(_, _, _, _, _, _, Impl), _),
- Impl = fc_impl_model_non(_, _, _, _, _, _, _, _, _)
- ->
- unexpected(this_file,
- "deep profiling is incompatible with nondet foreign code")
- ;
% We don't want to transform the procedures for managing the deep
% profiling call graph, or we'd get infinite recursion.
PredModuleName = mercury_profiling_builtin_module
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.223
diff -u -r1.223 det_analysis.m
--- compiler/det_analysis.m 30 Jul 2010 05:16:09 -0000 1.223
+++ compiler/det_analysis.m 23 Aug 2010 07:03:55 -0000
@@ -1103,7 +1103,7 @@
list(failing_context)::in, determinism::out, list(failing_context)::out,
det_info::in, det_info::out) is det.
-det_infer_foreign_proc(Attributes, PredId, ProcId, PragmaCode,
+det_infer_foreign_proc(Attributes, PredId, ProcId, _PragmaCode,
GoalInfo, SolnContext, RightFailingContexts,
Detism, GoalFailingContexts, !DetInfo) :-
% Foreign_procs are handled in the same way as predicate calls.
@@ -1135,18 +1135,7 @@
true
),
(
- PragmaCode = fc_impl_model_non(_, _, _, _, _, _, _, _, _),
- % Foreign_procs codes of this form can have more than one
- % solution.
- NumSolns1 = at_most_many
- ;
- ( PragmaCode = fc_impl_ordinary(_, _)
- ; PragmaCode = fc_impl_import(_, _, _, _)
- ),
- NumSolns1 = NumSolns0
- ),
- (
- NumSolns1 = at_most_many_cc,
+ NumSolns0 = at_most_many_cc,
SolnContext = all_solns
->
GoalContext = goal_info_get_context(GoalInfo),
@@ -1167,7 +1156,7 @@
det_info_add_error_spec(Spec, !DetInfo),
NumSolns = at_most_many
;
- NumSolns = NumSolns1
+ NumSolns = NumSolns0
),
determinism_components(Detism, CanFail, NumSolns),
(
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.84
diff -u -r1.84 equiv_type.m
--- compiler/equiv_type.m 5 Nov 2009 06:34:38 -0000 1.84
+++ compiler/equiv_type.m 30 Aug 2010 07:06:29 -0000
@@ -639,7 +639,6 @@
; Pragma0 = pragma_foreign_export(_, _, _, _, _)
; Pragma0 = pragma_foreign_export_enum(_, _, _, _, _)
; Pragma0 = pragma_foreign_import_module(_, _)
- ; Pragma0 = pragma_import(_, _, _, _, _)
; Pragma0 = pragma_inline(_, _)
; Pragma0 = pragma_mm_tabling_info(_, _, _, _, _)
; Pragma0 = pragma_mode_check_clauses(_, _)
Index: compiler/erl_call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_call_gen.m,v
retrieving revision 1.16
diff -u -r1.16 erl_call_gen.m
--- compiler/erl_call_gen.m 4 Jun 2009 07:56:47 -0000 1.16
+++ compiler/erl_call_gen.m 30 Aug 2010 06:55:36 -0000
@@ -541,28 +541,20 @@
erl_gen_foreign_code_call(ForeignArgs, MaybeTraceRuntimeCond,
PragmaImpl, CodeModel, OuterContext, MaybeSuccessExpr, Statement,
!Info) :-
+ PragmaImpl = fc_impl_ordinary(ForeignCode, MaybeContext),
(
- PragmaImpl = fc_impl_ordinary(ForeignCode, MaybeContext),
+ MaybeTraceRuntimeCond = no,
(
- MaybeTraceRuntimeCond = no,
- (
- MaybeContext = yes(Context)
- ;
- MaybeContext = no,
- Context = OuterContext
- ),
- erl_gen_ordinary_pragma_foreign_code(ForeignArgs, ForeignCode,
- CodeModel, Context, MaybeSuccessExpr, Statement, !Info)
+ MaybeContext = yes(Context)
;
- MaybeTraceRuntimeCond = yes(TraceRuntimeCond),
- erl_gen_trace_runtime_cond(TraceRuntimeCond, Statement, !Info)
- )
- ;
- PragmaImpl = fc_impl_model_non(_, _, _, _, _, _, _, _, _),
- sorry(this_file, "erl_gen_goal_expr: fc_impl_model_non")
+ MaybeContext = no,
+ Context = OuterContext
+ ),
+ erl_gen_ordinary_pragma_foreign_code(ForeignArgs, ForeignCode,
+ CodeModel, Context, MaybeSuccessExpr, Statement, !Info)
;
- PragmaImpl = fc_impl_import(_, _, _, _),
- sorry(this_file, "erl_gen_goal_expr: fc_impl_import")
+ MaybeTraceRuntimeCond = yes(TraceRuntimeCond),
+ erl_gen_trace_runtime_cond(TraceRuntimeCond, Statement, !Info)
).
%-----------------------------------------------------------------------------%
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.83
diff -u -r1.83 foreign.m
--- compiler/foreign.m 4 Nov 2009 03:44:47 -0000 1.83
+++ compiler/foreign.m 30 Aug 2010 06:48:16 -0000
@@ -24,12 +24,10 @@
:- import_module hlds.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_module.
-:- import_module hlds.hlds_pred.
:- import_module libs.globals.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.
-:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_foreign.
@@ -140,20 +138,6 @@
pragma_foreign_proc_attributes::in, pragma_foreign_proc_attributes::out,
pragma_foreign_code_impl::in, pragma_foreign_code_impl::out) is det.
- % make_pragma_import turns pragma imports into pragma foreign_code.
- % Given the pred and proc info for this predicate, the name
- % of the function to import, the context of the import pragma
- % and the module_info, create a pragma_foreign_code_impl
- % which imports the foreign function, and return the varset,
- % pragma_vars, argument types and other information about the
- % generated predicate body.
- %
-:- pred make_pragma_import(pred_info::in, proc_info::in, string::in,
- prog_context::in, pragma_foreign_code_impl::out,
- prog_varset::out, list(pragma_var)::out, list(mer_type)::out, arity::out,
- pred_or_func::out, module_info::in, module_info::out,
- list(error_spec)::in, list(error_spec)::out) is det.
-
% The name of the #define which can be used to guard declarations with
% to prevent entities being declared twice.
%
@@ -175,6 +159,7 @@
:- import_module libs.
:- import_module libs.compiler_util.
:- import_module libs.globals.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_util.
@@ -343,43 +328,6 @@
make_pred_name_rest(lang_java, _SymName) = "some_java_name".
make_pred_name_rest(lang_erlang, _SymName) = "some_erlang_name".
-make_pragma_import(PredInfo, ProcInfo, C_Function, Context, PragmaImpl, VarSet,
- PragmaVars, ArgTypes, Arity, PredOrFunc, !ModuleInfo, !Specs) :-
-
- % Lookup some information we need from the pred_info and proc_info.
- PredOrFunc = pred_info_is_pred_or_func(PredInfo),
- pred_info_get_arg_types(PredInfo, ArgTypes),
- proc_info_get_argmodes(ProcInfo, Modes),
- CodeModel = proc_info_interface_code_model(ProcInfo),
-
- % Build a list of argument variables, together with their names, modes,
- % and types.
- varset.init(VarSet0),
- list.length(Modes, Arity),
- varset.new_vars(VarSet0, Arity, Vars, VarSet),
- create_pragma_vars(Vars, Modes, 0, PragmaVars),
- assoc_list.from_corresponding_lists(PragmaVars, ArgTypes,
- PragmaVarsAndTypes),
-
- % Construct parts of the C_code string for calling a C_function. This C
- % code fragment invokes the specified C function with the appropriate
- % arguments from the list constructed above, passed in the appropriate
- % manner (by value, or by passing the address to simulate
- % pass-by-reference), and assigns the return value (if any) to the
- % appropriate place. As this phase occurs before polymorphism, we don't
- % know about the type-infos yet. polymorphism.m is responsible for adding
- % the type-info arguments to the list of variables.
-
- proc_info_get_declared_determinism(ProcInfo, MaybeDeclaredDetism),
- handle_return_value(Context, MaybeDeclaredDetism, CodeModel, PredOrFunc,
- PragmaVarsAndTypes, ArgPragmaVarsAndTypes, Return, !ModuleInfo,
- !Specs),
- assoc_list.keys(ArgPragmaVarsAndTypes, ArgPragmaVars),
- create_pragma_import_c_code(ArgPragmaVars, !.ModuleInfo, "", Variables),
-
- % Make an import implementation.
- PragmaImpl = fc_impl_import(C_Function, Return, Variables, yes(Context)).
-
% handle_return_value(Contxt, DeclaredDetism, CodeModel, PredOrFunc, Args0,
% M, Args, C_Code0):
%
Index: compiler/gcc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/gcc.m,v
retrieving revision 1.35
diff -u -r1.35 gcc.m
--- compiler/gcc.m 14 Oct 2009 05:28:32 -0000 1.35
+++ compiler/gcc.m 30 Aug 2010 10:37:25 -0000
@@ -767,14 +767,20 @@
% Returns `yes' iff we've already entered the gcc back-end.
%
:- pred in_gcc(bool::out, io::di, io::uo) is det.
-:- pragma import(in_gcc(out, di, uo),
- [will_not_call_mercury, tabled_for_io],
- "MC_in_gcc").
+:- pragma foreign_proc("C",
+ in_gcc(Result::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ MC_in_gcc(&Result);
+").
:- pred call_gcc_backend(string::in, int::out, io::di, io::uo) is det.
-:- pragma import(call_gcc_backend(in, out, di, uo),
- [may_call_mercury, tabled_for_io],
- "MC_call_gcc_backend").
+:- pragma foreign_proc("C",
+ call_gcc_backend(AllArgs::in, Result::out, _IO0::di, _IO::uo),
+ [promise_pure, may_call_mercury, tabled_for_io],
+"
+ MC_call_gcc_backend(AllArgs, &Result);
+").
:- pragma foreign_decl("C", "
/* We use an `MC_' prefix for C code in the mercury/compiler directory. */
@@ -880,7 +886,7 @@
gcc_frontend_callback(T)::in(gcc_frontend_callback), T::out,
io::di, io::uo) is det.
-:- pragma export(
+:- pragma foreign_export("C",
call_frontend_callback(in(gcc_frontend_callback), out, di, uo),
"MC_call_frontend_callback").
@@ -1691,13 +1697,19 @@
% collector (see gcc/ggc.h).
%
-:- 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, tabled_for_io],
- "ggc_pop_context").
+:- pragma foreign_proc("C",
+ push_gc_context(_IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ ggc_push_context();
+").
+
+:- pragma foreign_proc("C",
+ pop_gc_context(_IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ ggc_pop_context();
+").
%-----------------------------------------------------------------------------%
%
@@ -1711,9 +1723,12 @@
merc_start_function((tree) FuncDecl);
").
-:- pragma import(end_function(di, uo),
- [will_not_call_mercury, tabled_for_io],
- "merc_end_function").
+:- pragma foreign_proc("C",
+ end_function(_IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+ merc_end_function();
+").
:- pragma foreign_proc("C",
set_context(FileName::in, LineNumber::in, _IO0::di, _IO::uo),
@@ -1765,13 +1780,19 @@
expand_start_cond((tree) Cond, 0);
").
-:- 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, tabled_for_io],
- "expand_end_cond").
+:- pragma foreign_proc("C",
+ gen_start_else(_IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ expand_start_else();
+").
+
+:- pragma foreign_proc("C",
+ gen_end_cond(_IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ expand_end_cond();
+").
%
% Switch statements.
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.173
diff -u -r1.173 goal_util.m
--- compiler/goal_util.m 4 Jul 2010 10:24:08 -0000 1.173
+++ compiler/goal_util.m 23 Aug 2010 07:08:04 -0000
@@ -1861,17 +1861,8 @@
%-----------------------------------------------------------------------------%
foreign_code_uses_variable(Impl, VarName) :-
- (
- Impl = fc_impl_ordinary(ForeignBody, _),
- string.sub_string_search(ForeignBody, VarName, _)
- ;
- Impl = fc_impl_model_non(FB1, _, FB2, _, FB3, _, _, FB4, _),
- ( string.sub_string_search(FB1, VarName, _)
- ; string.sub_string_search(FB2, VarName, _)
- ; string.sub_string_search(FB3, VarName, _)
- ; string.sub_string_search(FB4, VarName, _)
- )
- ).
+ Impl = fc_impl_ordinary(ForeignBody, _),
+ string.sub_string_search(ForeignBody, VarName, _).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_out_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_goal.m,v
retrieving revision 1.1
diff -u -r1.1 hlds_out_goal.m
--- compiler/hlds_out_goal.m 4 Nov 2009 03:44:47 -0000 1.1
+++ compiler/hlds_out_goal.m 30 Aug 2010 06:57:01 -0000
@@ -1466,42 +1466,10 @@
!IO),
io.write_string("},\n", !IO)
),
- (
- PragmaCode = fc_impl_ordinary(C_Code, _),
- io.write_string("""", !IO),
- io.write_string(C_Code, !IO),
- io.write_string("""", !IO)
- ;
- PragmaCode = fc_impl_model_non(Fields, _FieldsContext,
- First, _FirstContext, Later, _LaterContext,
- Treat, Shared, _SharedContext),
- io.write_string("local_vars(""", !IO),
- io.write_string(Fields, !IO),
- io.write_string("""), ", !IO),
- io.write_string("first_code(""", !IO),
- io.write_string(First, !IO),
- io.write_string("""), ", !IO),
- io.write_string("retry_code(""", !IO),
- io.write_string(Later, !IO),
- io.write_string("""), ", !IO),
- (
- Treat = shared_code_share,
- io.write_string("shared_code(""", !IO)
- ;
- Treat = shared_code_duplicate,
- io.write_string("duplicated_code(""", !IO)
- ;
- Treat = shared_code_automatic,
- io.write_string("common_code(""", !IO)
- ),
- io.write_string(Shared, !IO),
- io.write_string(""")", !IO)
- ;
- PragmaCode = fc_impl_import(Name, _, _, _Context),
- io.write_string("""", !IO),
- io.write_string(Name, !IO),
- io.write_string("""", !IO)
- ),
+ PragmaCode = fc_impl_ordinary(C_Code, _),
+ io.write_string("""", !IO),
+ io.write_string(C_Code, !IO),
+ io.write_string("""", !IO),
io.write_string(")", !IO),
io.write_string(Follow, !IO).
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.100
diff -u -r1.100 make_hlds_passes.m
--- compiler/make_hlds_passes.m 30 Jul 2010 05:16:12 -0000 1.100
+++ compiler/make_hlds_passes.m 30 Aug 2010 06:58:30 -0000
@@ -1199,11 +1199,6 @@
Vars, ProgVarSet, InstVarSet, PragmaImpl, !.Status, Context,
yes(SeqNum), !ModuleInfo, !QualInfo, !Specs)
;
- Pragma = pragma_import(Name, PredOrFunc, Modes, Attributes,
- C_Function),
- module_add_pragma_import(Name, PredOrFunc, Modes, Attributes,
- C_Function, !.Status, Context, !ModuleInfo, !QualInfo, !Specs)
- ;
Pragma = pragma_fact_table(Pred, Arity, File),
module_add_pragma_fact_table(Pred, Arity, File, !.Status,
Context, !ModuleInfo, !QualInfo, !Specs)
Index: compiler/make_hlds_warn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_warn.m,v
retrieving revision 1.36
diff -u -r1.36 make_hlds_warn.m
--- compiler/make_hlds_warn.m 7 May 2010 03:12:23 -0000 1.36
+++ compiler/make_hlds_warn.m 30 Aug 2010 06:59:20 -0000
@@ -403,99 +403,28 @@
warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang, Args, Context,
PredOrFuncCallId, PredId, ProcId, ModuleInfo, !Specs) :-
LangStr = foreign_language_string(Lang),
+ PragmaImpl = fc_impl_ordinary(C_Code, _),
+ c_code_to_name_list(C_Code, C_CodeList),
+ list.filter_map(var_is_unmentioned(C_CodeList), Args, UnmentionedVars),
(
- PragmaImpl = fc_impl_ordinary(C_Code, _),
- c_code_to_name_list(C_Code, C_CodeList),
- list.filter_map(var_is_unmentioned(C_CodeList), Args, UnmentionedVars),
- (
- UnmentionedVars = []
- ;
- UnmentionedVars = [_ | _],
- Pieces1 = [words("In the"), words(LangStr), words("code for"),
- simple_call(PredOrFuncCallId), suffix(":"), nl] ++
- variable_warning_start(UnmentionedVars) ++
- [words("not occur in the"), words(LangStr), words("code."),
- nl],
- Msg1 = simple_msg(Context,
- [option_is_set(warn_singleton_vars, yes, [always(Pieces1)])]),
- Severity1 = severity_conditional(warn_singleton_vars, yes,
- severity_warning, no),
- Spec1 = error_spec(Severity1, phase_parse_tree_to_hlds,
- [Msg1]),
- !:Specs = [Spec1 | !.Specs]
- ),
- pragma_foreign_proc_body_checks(Lang, Context, PredOrFuncCallId,
- PredId, ProcId, ModuleInfo, C_CodeList, !Specs)
+ UnmentionedVars = []
;
- PragmaImpl = fc_impl_model_non(_, _, FirstCode, _, LaterCode,
- _, _, SharedCode, _),
- c_code_to_name_list(FirstCode, FirstCodeList),
- c_code_to_name_list(LaterCode, LaterCodeList),
- c_code_to_name_list(SharedCode, SharedCodeList),
- list.filter_map(input_var_is_unmentioned(ModuleInfo, FirstCodeList),
- Args, UnmentionedInputVars),
- (
- UnmentionedInputVars = []
- ;
- UnmentionedInputVars = [_ | _],
- Pieces2 = [words("In the"), words(LangStr), words("code for"),
- simple_call(PredOrFuncCallId), suffix(":"), nl] ++
- variable_warning_start(UnmentionedInputVars) ++
- [words("not occur in the first"), words(LangStr),
- words("code."), nl],
- Msg2 = simple_msg(Context,
- [option_is_set(warn_singleton_vars, yes, [always(Pieces2)])]),
- Severity2 = severity_conditional(warn_singleton_vars, yes,
- severity_warning, no),
- Spec2 = error_spec(Severity2, phase_parse_tree_to_hlds,
- [Msg2]),
- !:Specs = [Spec2 | !.Specs]
- ),
- list.filter_map(output_var_is_unmentioned(ModuleInfo,
- FirstCodeList, SharedCodeList), Args, UnmentionedFirstOutputVars),
- (
- UnmentionedFirstOutputVars = []
- ;
- UnmentionedFirstOutputVars = [_ | _],
- Pieces3 = [words("In the"), words(LangStr), words("code for"),
- simple_call(PredOrFuncCallId), suffix(":"), nl] ++
- variable_warning_start(UnmentionedFirstOutputVars) ++
- [words("not occur in the first"), words(LangStr),
- words("code or the shared"), words(LangStr), words("code."),
- nl],
- Msg3 = simple_msg(Context,
- [option_is_set(warn_singleton_vars, yes, [always(Pieces3)])]),
- Severity3 = severity_conditional(warn_singleton_vars, yes,
- severity_warning, no),
- Spec3 = error_spec(Severity3, phase_parse_tree_to_hlds,
- [Msg3]),
- !:Specs = [Spec3 | !.Specs]
- ),
- list.filter_map(output_var_is_unmentioned(ModuleInfo,
- LaterCodeList, SharedCodeList), Args, UnmentionedLaterOutputVars),
- (
- UnmentionedLaterOutputVars = []
- ;
- UnmentionedLaterOutputVars = [_ | _],
- list.sort(UnmentionedLaterOutputVars,
- SortedUnmentionedLaterOutputVars),
- Pieces4 = [words("In the"), words(LangStr), words("code for"),
- simple_call(PredOrFuncCallId), suffix(":"), nl] ++
- variable_warning_start(SortedUnmentionedLaterOutputVars) ++
- [words("not occur in the retry"), words(LangStr),
- words("code or the shared"), words(LangStr), words("code."),
- nl],
- Msg4 = simple_msg(Context,
- [option_is_set(warn_singleton_vars, yes, [always(Pieces4)])]),
- Severity4 = severity_conditional(warn_singleton_vars, yes,
- severity_warning, no),
- Spec4 = error_spec(Severity4, phase_parse_tree_to_hlds,
- [Msg4]),
- !:Specs = [Spec4 | !.Specs]
- )
- ;
- PragmaImpl = fc_impl_import(_, _, _, _)
- ).
+ UnmentionedVars = [_ | _],
+ Pieces1 = [words("In the"), words(LangStr), words("code for"),
+ simple_call(PredOrFuncCallId), suffix(":"), nl] ++
+ variable_warning_start(UnmentionedVars) ++
+ [words("not occur in the"), words(LangStr), words("code."),
+ nl],
+ Msg1 = simple_msg(Context,
+ [option_is_set(warn_singleton_vars, yes, [always(Pieces1)])]),
+ Severity1 = severity_conditional(warn_singleton_vars, yes,
+ severity_warning, no),
+ Spec1 = error_spec(Severity1, phase_parse_tree_to_hlds,
+ [Msg1]),
+ !:Specs = [Spec1 | !.Specs]
+ ),
+ pragma_foreign_proc_body_checks(Lang, Context, PredOrFuncCallId,
+ PredId, ProcId, ModuleInfo, C_CodeList, !Specs).
:- pred var_is_unmentioned(list(string)::in, maybe(pair(string, mer_mode))::in,
string::out) is semidet.
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.341
diff -u -r1.341 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 4 Aug 2010 02:44:09 -0000 1.341
+++ compiler/mercury_to_mercury.m 30 Aug 2010 07:09:20 -0000
@@ -690,15 +690,6 @@
mercury_output_pragma_foreign_code(Attributes, Pred,
PredOrFunc, Vars, ProgVarset, InstVarset, PragmaCode, !IO)
;
- Pragma = pragma_import(Pred, PredOrFunc, ModeList, Attributes,
- C_Function),
- % XXX the varset is only used for writing some `sharing' annotations.
- % It's unlikely anyone would write `sharing' annotations with `pragma
- % import' (which is deprecated) so just make up a varset.
- ProgVarset = varset.init,
- mercury_format_pragma_import(Pred, PredOrFunc, ModeList,
- Attributes, ProgVarset, C_Function, !IO)
- ;
Pragma = pragma_foreign_export(Lang, Pred, PredOrFunc, ModeList,
ExportName),
mercury_format_pragma_foreign_export(Lang, Pred, PredOrFunc, ModeList,
@@ -3548,24 +3539,9 @@
mercury_format_pragma_foreign_code(Attributes, PredName, PredOrFunc, Vars0,
ProgVarset, InstVarset, PragmaCode, !U) :-
- (
- PragmaCode = fc_impl_import(C_Function, _, _, _),
- % The predicate or function arguments in a `:- pragma import'
- % declaration are not named.
- ImportModes = list.map(
- (func(pragma_var(_, _, ImportMode, _)) = ImportMode), Vars0),
-
- mercury_format_pragma_import(PredName, PredOrFunc, ImportModes,
- Attributes, ProgVarset, C_Function, !U)
- ;
- PragmaCode = fc_impl_ordinary(_, _),
- mercury_format_pragma_foreign_code_2(Attributes, PredName,
- PredOrFunc, Vars0, ProgVarset, InstVarset, PragmaCode, !U)
- ;
- PragmaCode = fc_impl_model_non(_, _, _, _, _, _, _, _, _),
- mercury_format_pragma_foreign_code_2(Attributes, PredName,
- PredOrFunc, Vars0, ProgVarset, InstVarset, PragmaCode, !U)
- ).
+ PragmaCode = fc_impl_ordinary(_, _),
+ mercury_format_pragma_foreign_code_2(Attributes, PredName,
+ PredOrFunc, Vars0, ProgVarset, InstVarset, PragmaCode, !U).
:- pred mercury_format_pragma_foreign_code_2(
pragma_foreign_proc_attributes::in, sym_name::in, pred_or_func::in,
@@ -3609,38 +3585,8 @@
add_string(", ", !U),
mercury_format_pragma_foreign_attributes(Attributes, ProgVarset, !U),
add_string(", ", !U),
- (
- PragmaCode = fc_impl_ordinary(C_Code, _),
- mercury_format_foreign_code_string(C_Code, !U)
- ;
- PragmaCode = fc_impl_model_non(Fields, _, First, _, Later, _,
- Treat, Shared, _),
- add_string("local_vars(", !U),
- mercury_format_foreign_code_string(Fields, !U),
- add_string("), ", !U),
- add_string("first_code(", !U),
- mercury_format_foreign_code_string(First, !U),
- add_string("), ", !U),
- add_string("retry_code(", !U),
- mercury_format_foreign_code_string(Later, !U),
- add_string("), ", !U),
- (
- Treat = shared_code_share,
- add_string("shared_code(", !U)
- ;
- Treat = shared_code_duplicate,
- add_string("duplicated_code(", !U)
- ;
- Treat = shared_code_automatic,
- add_string("common_code(", !U)
- ),
- mercury_format_foreign_code_string(Shared, !U),
- add_string(")", !U)
- ;
- PragmaCode = fc_impl_import(_, _, _, _),
- % This should be handle in mercury_output_pragma_foreign_code.
- unexpected(this_file, "mercury_output_pragma_foreign_code_2")
- ),
+ PragmaCode = fc_impl_ordinary(C_Code, _),
+ mercury_format_foreign_code_string(C_Code, !U),
add_string(").\n", !U).
%-----------------------------------------------------------------------------%
@@ -3886,37 +3832,6 @@
%-----------------------------------------------------------------------------%
-:- pred mercury_format_pragma_import(sym_name::in, pred_or_func::in,
- list(mer_mode)::in, pragma_foreign_proc_attributes::in, prog_varset::in,
- string::in, U::di, U::uo) is det <= output(U).
-
-mercury_format_pragma_import(Name, PredOrFunc, ModeList, Attributes,
- ProgVarset, C_Function, !U) :-
- varset.init(InstVarset), % the varset isn't really used.
- InstInfo = simple_inst_info(InstVarset),
- add_string(":- pragma import(", !U),
- mercury_format_sym_name(Name, !U),
- (
- PredOrFunc = pf_function,
- pred_args_to_func_args(ModeList, ArgModes, RetMode),
- add_string("(", !U),
- mercury_format_mode_list(ArgModes, InstInfo, !U),
- add_string(") = ", !U),
- mercury_format_mode(RetMode, InstInfo, !U)
- ;
- PredOrFunc = pf_predicate,
- add_string("(", !U),
- mercury_format_mode_list(ModeList, InstInfo, !U),
- add_string(")", !U)
- ),
- add_string(", ", !U),
- mercury_format_pragma_foreign_attributes(Attributes, ProgVarset, !U),
- add_string(", """, !U),
- add_string(C_Function, !U),
- add_string(""").\n", !U).
-
-%-----------------------------------------------------------------------------%
-
:- pred mercury_format_pragma_foreign_export_enum(foreign_language::in,
sym_name::in, arity::in, export_enum_attributes::in,
assoc_list(sym_name, string)::in, U::di, U::uo) is det <= output(U).
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.227
diff -u -r1.227 ml_code_gen.m
--- compiler/ml_code_gen.m 2 Oct 2009 03:55:28 -0000 1.227
+++ compiler/ml_code_gen.m 30 Aug 2010 07:04:38 -0000
@@ -640,48 +640,22 @@
;
GoalExpr = call_foreign_proc(Attributes, PredId, ProcId,
Args, ExtraArgs, MaybeTraceRuntimeCond, PragmaImpl),
+ PragmaImpl = fc_impl_ordinary(ForeignCode, MaybeContext),
(
- PragmaImpl = fc_impl_ordinary(ForeignCode, MaybeContext),
- (
- MaybeContext = yes(ContextToUse)
- ;
- MaybeContext = no,
- ContextToUse = Context
- ),
- (
- MaybeTraceRuntimeCond = no,
- ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
- PredId, ProcId, Args, ExtraArgs, ForeignCode,
- ContextToUse, Decls, Statements, !Info)
- ;
- MaybeTraceRuntimeCond = yes(TraceRuntimeCond),
- ml_gen_trace_runtime_cond(TraceRuntimeCond, ContextToUse,
- Decls, Statements, !Info)
- )
- ;
- PragmaImpl = fc_impl_model_non(LocalVarsDecls, LocalVarsContext,
- FirstCode, FirstContext, LaterCode, LaterContext,
- _Treatment, SharedCode, SharedContext),
- expect(unify(ExtraArgs, []), this_file,
- "ml_gen_goal_expr: extra args"),
- expect(unify(MaybeTraceRuntimeCond, no), this_file,
- "ml_gen_goal_expr: MaybeTraceRuntimeCond"),
- ml_gen_nondet_pragma_foreign_proc(CodeModel, Attributes,
- PredId, ProcId, Args, Context,
- LocalVarsDecls, LocalVarsContext,
- FirstCode, FirstContext, LaterCode, LaterContext,
- SharedCode, SharedContext, Decls, Statements, !Info)
- ;
- PragmaImpl = fc_impl_import(Name, HandleReturn, Vars, _Context),
- expect(unify(ExtraArgs, []), this_file,
- "ml_gen_goal_expr: extra args"),
- expect(unify(MaybeTraceRuntimeCond, no), this_file,
- "ml_gen_goal_expr: MaybeTraceRuntimeCond"),
- ForeignCode = string.append_list([HandleReturn, " ",
- Name, "(", Vars, ");"]),
+ MaybeContext = yes(ContextToUse)
+ ;
+ MaybeContext = no,
+ ContextToUse = Context
+ ),
+ (
+ MaybeTraceRuntimeCond = no,
ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
PredId, ProcId, Args, ExtraArgs, ForeignCode,
- Context, Decls, Statements, !Info)
+ ContextToUse, Decls, Statements, !Info)
+ ;
+ MaybeTraceRuntimeCond = yes(TraceRuntimeCond),
+ ml_gen_trace_runtime_cond(TraceRuntimeCond, ContextToUse,
+ Decls, Statements, !Info)
)
;
GoalExpr = conj(_ConjType, Goals),
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.177
diff -u -r1.177 module_qual.m
--- compiler/module_qual.m 2 Feb 2010 05:20:26 -0000 1.177
+++ compiler/module_qual.m 30 Aug 2010 07:10:04 -0000
@@ -1374,10 +1374,6 @@
qualify_pragma(X @ pragma_no_inline(_, _), X, !Info, !Specs).
qualify_pragma(X @ pragma_obsolete(_, _), X, !Info, !Specs).
qualify_pragma(X, Y, !Info, !Specs) :-
- X = pragma_import(Name, PredOrFunc, Modes0, Attributes, CFunc),
- qualify_mode_list(Modes0, Modes, !Info, !Specs),
- Y = pragma_import(Name, PredOrFunc, Modes, Attributes, CFunc).
-qualify_pragma(X, Y, !Info, !Specs) :-
X = pragma_foreign_export(Lang, Name, PredOrFunc, Modes0, CFunc),
qualify_mode_list(Modes0, Modes, !Info, !Specs),
Y = pragma_foreign_export(Lang, Name, PredOrFunc, Modes, CFunc).
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.458
diff -u -r1.458 modules.m
--- compiler/modules.m 13 Jan 2010 04:21:23 -0000 1.458
+++ compiler/modules.m 30 Aug 2010 07:10:48 -0000
@@ -1589,7 +1589,6 @@
; Pragma = pragma_foreign_proc(_, _, _, _, _, _, _)
; Pragma = pragma_inline(_, _)
; Pragma = pragma_no_inline(_, _)
- ; Pragma = pragma_import(_, _, _, _, _)
; Pragma = pragma_fact_table(_, _, _)
; Pragma = pragma_tabled(_, _, _, _, _, _)
; Pragma = pragma_promise_pure(_, _)
@@ -3768,10 +3767,6 @@
Item = item_pragma(ItemPragma),
ItemPragma = item_pragma_info(_, Pragma, _, _),
(
- Pragma = pragma_import(_, _, _, _, _),
- % `:- pragma import' is only supported for C.
- Langs = [lang_c]
- ;
( Pragma = pragma_foreign_decl(Lang, _, _)
; Pragma = pragma_foreign_code(Lang, _)
; Pragma = pragma_foreign_enum(Lang, _, _, _)
@@ -3880,7 +3875,6 @@
; Pragma = pragma_foreign_code(_, _)
; Pragma = pragma_foreign_proc(_, _, _, _, _, _, _)
; Pragma = pragma_foreign_export(_, _, _, _, _)
- ; Pragma = pragma_import(_, _, _, _, _)
; Pragma = pragma_foreign_export_enum(_, _, _, _, _)
; Pragma = pragma_type_spec(_, _, _, _, _, _, _, _)
; Pragma = pragma_inline(_, _)
@@ -4287,7 +4281,6 @@
; Pragma = pragma_foreign_decl(_, _, _), Reorderable = no
; Pragma = pragma_foreign_import_module(_, _), Reorderable = no
; Pragma = pragma_foreign_proc(_, _, _, _, _, _, _), Reorderable = no
- ; Pragma = pragma_import(_, _, _, _, _), Reorderable = no
; Pragma = pragma_inline(_, _), Reorderable = yes
; Pragma = pragma_mode_check_clauses(_, _), Reorderable = yes
; Pragma = pragma_no_inline(_, _), Reorderable = yes
@@ -4388,7 +4381,6 @@
; Pragma = pragma_foreign_proc(_, _, _, _, _, _, _), Reorderable = no
; Pragma = pragma_foreign_export_enum(_, _, _, _, _), Reorderable = yes
; Pragma = pragma_foreign_enum(_, _, _, _), Reorderable = yes
- ; Pragma = pragma_import(_, _, _, _, _), Reorderable = no
; Pragma = pragma_inline(_, _), Reorderable = yes
; Pragma = pragma_mode_check_clauses(_, _), Reorderable = yes
; Pragma = pragma_no_inline(_, _), Reorderable = yes
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.350
diff -u -r1.350 polymorphism.m
--- compiler/polymorphism.m 30 Jul 2010 05:16:14 -0000 1.350
+++ compiler/polymorphism.m 30 Aug 2010 06:53:28 -0000
@@ -1790,45 +1790,20 @@
ground,ground,ground))), hlds_goal_info::in, hlds_goal::out,
poly_info::in, poly_info::out) is det.
-polymorphism_process_foreign_proc(ModuleInfo, PredInfo, Goal0, GoalInfo0, Goal,
+polymorphism_process_foreign_proc(_ModuleInfo, PredInfo, Goal0, GoalInfo0, Goal,
!Info) :-
% Insert the type_info vars into the argname map, so that the foreign_proc
% can refer to the type_info variable for type T as `TypeInfo_for_T'.
Goal0 = call_foreign_proc(Attributes, PredId, ProcId, Args0, ProcExtraArgs,
- MaybeTraceRuntimeCond, Impl0),
+ MaybeTraceRuntimeCond, Impl),
ArgVars0 = list.map(foreign_arg_var, Args0),
polymorphism_process_call(PredId, ArgVars0, GoalInfo0, GoalInfo,
ExtraVars, ExtraGoals, !Info),
- (
- Impl0 = fc_impl_import(_, _, _, _),
- % The reference manual guarantees a one-to-one correspondence between
- % the arguments of the predicate (as augmented by with type_info and/or
- % typeclass_info arguments by polymorphism.m) and the arguments of the
- % imported function.
- CanOptAwayUnnamed = no
- ;
- ( Impl0 = fc_impl_ordinary(_, _)
- ; Impl0 = fc_impl_model_non(_, _, _, _, _, _, _, _, _)
- ),
- CanOptAwayUnnamed = yes
- ),
- polymorphism_process_foreign_proc_args(PredInfo, CanOptAwayUnnamed, Impl0,
+ CanOptAwayUnnamed = yes,
+ polymorphism_process_foreign_proc_args(PredInfo, CanOptAwayUnnamed, Impl,
ExtraVars, ExtraArgs),
Args = ExtraArgs ++ Args0,
- % Add the type info arguments to the list of variables
- % to call for a pragma import.
- (
- Impl0 = fc_impl_import(Name, HandleReturn, Variables0, MaybeContext),
- Variables = type_info_vars(ModuleInfo, ExtraArgs, Variables0),
- Impl = fc_impl_import(Name, HandleReturn, Variables, MaybeContext)
- ;
- ( Impl0 = fc_impl_ordinary(_, _)
- ; Impl0 = fc_impl_model_non(_, _, _, _, _, _, _, _, _)
- ),
- Impl = Impl0
- ),
-
% Plug it all back together.
CallExpr = call_foreign_proc(Attributes, PredId, ProcId,
Args, ProcExtraArgs, MaybeTraceRuntimeCond, Impl),
@@ -1846,7 +1821,7 @@
PredArgTypes),
% Find out which variables are constrained (so that we don't add
- % type_infos for them.
+ % type_infos for them).
pred_info_get_class_context(PredInfo, constraints(UnivCs, ExistCs)),
UnivVars0 = list.map(get_constrained_vars, UnivCs),
list.condense(UnivVars0, UnivConstrainedVars),
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.116
diff -u -r1.116 pragma_c_gen.m
--- compiler/pragma_c_gen.m 4 Nov 2009 03:44:50 -0000 1.116
+++ compiler/pragma_c_gen.m 30 Aug 2010 07:02:25 -0000
@@ -353,51 +353,23 @@
generate_foreign_proc_code(CodeModel, Attributes, PredId, ProcId,
Args, ExtraArgs, MaybeTraceRuntimeCond, PragmaImpl, GoalInfo, Code,
!CI) :-
+ PragmaImpl = fc_impl_ordinary(C_Code, Context),
(
- PragmaImpl = fc_impl_ordinary(C_Code, Context),
- (
- MaybeTraceRuntimeCond = no,
- CanOptAwayUnnamedArgs = yes,
- generate_ordinary_foreign_proc_code(CodeModel, Attributes,
- PredId, ProcId, Args, ExtraArgs, C_Code, Context, GoalInfo,
- CanOptAwayUnnamedArgs, Code, !CI)
- ;
- MaybeTraceRuntimeCond = yes(TraceRuntimeCond),
- expect(unify(Args, []), this_file,
- "generate_foreign_proc_code: args runtime cond"),
- expect(unify(ExtraArgs, []), this_file,
- "generate_foreign_proc_code: extra args runtime cond"),
- expect(unify(CodeModel, model_semi), this_file,
- "generate_foreign_proc_code: non-semi runtime cond"),
- generate_trace_runtime_cond_foreign_proc_code(TraceRuntimeCond,
- Code, !CI)
- )
- ;
- PragmaImpl = fc_impl_model_non(Fields, FieldsContext,
- First, FirstContext, Later, LaterContext,
- Treat, Shared, SharedContext),
- expect(unify(ExtraArgs, []), this_file,
- "generate_foreign_proc_code: extra args nondet"),
- require(unify(MaybeTraceRuntimeCond, no),
- "generate_foreign_proc_code: runtime cond nondet"),
+ MaybeTraceRuntimeCond = no,
CanOptAwayUnnamedArgs = yes,
- generate_nondet_foreign_proc_code(CodeModel, Attributes,
- PredId, ProcId, Args, Fields, FieldsContext,
- First, FirstContext, Later, LaterContext,
- Treat, Shared, SharedContext, CanOptAwayUnnamedArgs, Code, !CI)
- ;
- PragmaImpl = fc_impl_import(Name, HandleReturn, Vars, Context),
- expect(unify(ExtraArgs, []), this_file,
- "generate_foreign_proc_code: extra args import"),
- require(unify(MaybeTraceRuntimeCond, no),
- "generate_foreign_proc_code: runtime cond import"),
- C_Code = HandleReturn ++ " " ++ Name ++ "(" ++ Vars ++ ");",
-
- % The imported function was generated with all arguments present.
- CanOptAwayUnnamedArgs = no,
generate_ordinary_foreign_proc_code(CodeModel, Attributes,
PredId, ProcId, Args, ExtraArgs, C_Code, Context, GoalInfo,
CanOptAwayUnnamedArgs, Code, !CI)
+ ;
+ MaybeTraceRuntimeCond = yes(TraceRuntimeCond),
+ expect(unify(Args, []), this_file,
+ "generate_foreign_proc_code: args runtime cond"),
+ expect(unify(ExtraArgs, []), this_file,
+ "generate_foreign_proc_code: extra args runtime cond"),
+ expect(unify(CodeModel, model_semi), this_file,
+ "generate_foreign_proc_code: non-semi runtime cond"),
+ generate_trace_runtime_cond_foreign_proc_code(TraceRuntimeCond,
+ Code, !CI)
).
%---------------------------------------------------------------------------%
@@ -733,470 +705,6 @@
%-----------------------------------------------------------------------------%
-:- pred generate_nondet_foreign_proc_code(code_model::in,
- pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
- list(foreign_arg)::in,
- string::in, maybe(prog_context)::in,
- string::in, maybe(prog_context)::in,
- string::in, maybe(prog_context)::in,
- foreign_proc_shared_code_treatment::in,
- string::in, maybe(prog_context)::in, bool::in, llds_code::out,
- code_info::in, code_info::out) is det.
-
-generate_nondet_foreign_proc_code(CodeModel, Attributes, PredId, ProcId,
- Args, _Fields, _FieldsContext,
- First, FirstContext, Later, LaterContext, Treat, Shared, SharedContext,
- CanOptAwayUnnamedArgs, Code, !CI) :-
- expect(unify(CodeModel, model_non), this_file,
- "inappropriate code model for nondet foreign_proc"),
- % Extract the may_call_mercury attribute.
- MayCallMercury = get_may_call_mercury(Attributes),
- AffectsLiveness = get_affects_liveness(Attributes),
-
- % Generate #define MR_PROC_LABEL <procedure label> /* see note (5) */
- % and #undef MR_PROC_LABEL.
- get_module_info(!.CI, ModuleInfo),
- get_pred_id(!.CI, CallerPredId),
- get_proc_id(!.CI, CallerProcId),
- make_proc_label_hash_define(ModuleInfo, CallerPredId, CallerProcId,
- ProcLabelDefine, ProcLabelUndef),
-
- % Generate a unique prefix for the C labels that we will define.
- ProcLabelString = make_proc_label_string(ModuleInfo,
- PredId, ProcId),
-
- % Get a list of input and output arguments.
- ArgInfos = get_pred_proc_arginfo(!.CI, PredId, ProcId),
- make_c_arg_list(Args, ArgInfos, CArgs),
- foreign_proc_select_in_args(CArgs, InCArgs),
- foreign_proc_select_out_args(CArgs, OutCArgs),
- make_foreign_proc_decls(CArgs, ModuleInfo, CanOptAwayUnnamedArgs, Decls),
- make_foreign_proc_decls(OutCArgs, ModuleInfo, CanOptAwayUnnamedArgs,
- OutDecls),
-
- input_descs_from_arg_info(!.CI, InCArgs, CanOptAwayUnnamedArgs,
- InputDescs),
- output_descs_from_arg_info(!.CI, OutCArgs, CanOptAwayUnnamedArgs,
- OutputDescs),
-
- module_info_pred_info(ModuleInfo, PredId, PredInfo),
- ModuleName = pred_info_module(PredInfo),
- PredName = pred_info_name(PredInfo),
- Arity = pred_info_orig_arity(PredInfo),
- StructName = foreign_proc_struct_name(ModuleName, PredName, Arity, ProcId),
- SaveStructDecl = foreign_proc_struct_ptr_decl(StructName, "LOCALS"),
- string.format("\tLOCALS = (struct %s *) ((char *)
- (MR_curfr + 1 - MR_ORDINARY_SLOTS - MR_NONDET_FIXED_SIZE)
- - sizeof(struct %s));\n",
- [s(StructName), s(StructName)],
- InitSaveStruct),
-
- get_next_label(RetryLabel, !CI),
- ModFrameCode = singleton(
- llds_instr(assign(redoip_slot(lval(curfr)),
- const(llconst_code_addr(code_label(RetryLabel)))),
- "Set up backtracking to retry label")
- ),
- RetryLabelCode = singleton(
- llds_instr(label(RetryLabel), "Start of the retry block")
- ),
-
- get_globals(!.CI, Globals),
-
- globals.lookup_bool_option(Globals, reclaim_heap_on_nondet_failure,
- ReclaimHeap),
- maybe_save_hp(ReclaimHeap, SaveHeapCode, MaybeHpSlot, !CI),
- maybe_restore_hp(MaybeHpSlot, RestoreHeapCode),
-
- get_emit_trail_ops(!.CI, AddTrailOps),
- maybe_save_ticket(AddTrailOps, SaveTicketCode, MaybeTicketSlot, !CI),
- maybe_reset_ticket(MaybeTicketSlot, reset_reason_undo, RestoreTicketCode),
- (
- FirstContext = yes(ActualFirstContext)
- ;
- FirstContext = no,
- term.context_init(ActualFirstContext)
- ),
- maybe_generate_foreign_proc_event_code(nondet_foreign_proc_first,
- ActualFirstContext, FirstTraceCode, !CI),
- (
- LaterContext = yes(ActualLaterContext)
- ;
- LaterContext = no,
- term.context_init(ActualLaterContext)
- ),
- maybe_generate_foreign_proc_event_code(nondet_foreign_proc_later,
- ActualLaterContext, LaterTraceCode, !CI),
-
- FirstDisjunctCode = SaveHeapCode ++ SaveTicketCode ++ FirstTraceCode,
- LaterDisjunctCode = RestoreHeapCode ++ RestoreTicketCode ++ LaterTraceCode,
-
- % MR_save_registers(); /* see notes (1) and (2) above */
- % MR_restore_registers(); /* see notes (1) and (3) above */
- (
- MayCallMercury = proc_will_not_call_mercury,
- SaveRegs = "",
- RestoreRegs = ""
- ;
- MayCallMercury = proc_may_call_mercury,
- SaveRegs = "\tMR_save_registers();\n",
- RestoreRegs = "\tMR_restore_registers();\n"
- ),
-
- Succeed = "\tMR_succeed();\n",
- SucceedDiscard = "\tMR_succeed_discard();\n",
-
- CallDef1 = "#define\tSUCCEED \tgoto MR_call_success_"
- ++ ProcLabelString ++ "\n",
- CallDef2 = "#define\tSUCCEED_LAST\tgoto MR_call_success_last_"
- ++ ProcLabelString ++ "\n",
- CallDef3 = "#define\tFAIL\tMR_fail()\n",
-
- CallSuccessLabel = "MR_call_success_"
- ++ ProcLabelString ++ ":\n",
- CallLastSuccessLabel = "MR_call_success_last_"
- ++ ProcLabelString ++ ":\n",
-
- RetryDef1 = "#define\tSUCCEED \tgoto MR_retry_success_"
- ++ ProcLabelString ++ "\n",
- RetryDef2 = "#define\tSUCCEED_LAST\tgoto MR_retry_success_last_"
- ++ ProcLabelString ++ "\n",
- RetryDef3 = "#define\tFAIL\tMR_fail()\n",
-
- RetrySuccessLabel = "MR_retry_success_"
- ++ ProcLabelString ++ ":\n",
- RetryLastSuccessLabel = "MR_retry_success_last_"
- ++ ProcLabelString ++ ":\n",
-
- Undef1 = "#undef\tSUCCEED\n",
- Undef2 = "#undef\tSUCCEED_LAST\n",
- Undef3 = "#undef\tFAIL\n",
-
- MD = proc_may_not_duplicate,
- (
- % Use the form that duplicates the common code if the programmer
- % asked for it, or if the code is small enough for its duplication
- % not to have a significant effect on code size. (This form generates
- % slightly faster code.) However, if `pragma no_inline' is specified,
- % then we don't duplicate the code unless the programmer asked for it
- % -- the code may contain static variable declarations, so duplicating
- % it could change the semantics.
-
- % We use the number of semicolons in the code as an indication of
- % how many C statements it has and thus how big its object code
- % is likely to be.
- (
- Treat = shared_code_duplicate
- ;
- Treat = shared_code_automatic,
- \+ pred_info_requested_no_inlining(PredInfo),
- CountSemis = (pred(Char::in, Count0::in, Count::out) is det :-
- ( Char = (;) ->
- Count = Count0 + 1
- ;
- Count = Count0
- )
- ),
- string.foldl(CountSemis, Shared, 0, Semis),
- Semis < 32
- )
- ->
- CallDecls = [SaveStructDecl | Decls],
- CallComponents = [
- foreign_proc_inputs(InputDescs),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- InitSaveStruct),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SaveRegs),
- ProcLabelDefine,
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, CallDef1),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, CallDef2),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, CallDef3),
- foreign_proc_user_code(FirstContext, AffectsLiveness, First),
- foreign_proc_user_code(SharedContext, AffectsLiveness, Shared),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- CallSuccessLabel),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RestoreRegs),
- foreign_proc_outputs(OutputDescs),
- foreign_proc_raw_code(can_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- Succeed),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- CallLastSuccessLabel),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RestoreRegs),
- foreign_proc_outputs(OutputDescs),
- foreign_proc_raw_code(can_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SucceedDiscard),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef1),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef2),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef3),
- ProcLabelUndef
- ],
- CallBlockCode = singleton(
- llds_instr(foreign_proc_code(CallDecls, CallComponents,
- MayCallMercury, no, no, no, no, no, yes, MD),
- "Call and shared foreign_proc inclusion")
- ),
-
- RetryDecls = [SaveStructDecl | OutDecls],
- RetryComponents = [
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- InitSaveStruct),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SaveRegs),
- ProcLabelDefine,
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, RetryDef1),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, RetryDef2),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, RetryDef3),
- foreign_proc_user_code(LaterContext, AffectsLiveness, Later),
- foreign_proc_user_code(SharedContext, AffectsLiveness, Shared),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RetrySuccessLabel),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RestoreRegs),
- foreign_proc_outputs(OutputDescs),
- foreign_proc_raw_code(can_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- Succeed),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RetryLastSuccessLabel),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RestoreRegs),
- foreign_proc_outputs(OutputDescs),
- foreign_proc_raw_code(can_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SucceedDiscard),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef1),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef2),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef3),
- ProcLabelUndef
- ],
- RetryBlockCode = singleton(
- llds_instr(foreign_proc_code(RetryDecls, RetryComponents,
- MayCallMercury, no, no, no, no, no, yes, MD),
- "Retry and shared foreign_proc inclusion")
- ),
-
- Code = ModFrameCode ++ FirstDisjunctCode ++ CallBlockCode ++
- RetryLabelCode ++ LaterDisjunctCode ++ RetryBlockCode
- ;
- get_next_label(SharedLabel, !CI),
- SharedLabelCode = singleton(
- llds_instr(label(SharedLabel), "Start of the shared block")
- ),
-
- SharedDef1 =
- "#define\tSUCCEED \tgoto MR_shared_success_"
- ++ ProcLabelString ++ "\n",
- SharedDef2 =
- "#define\tSUCCEED_LAST\tgoto MR_shared_success_last_"
- ++ ProcLabelString ++ "\n",
- SharedDef3 = "#define\tFAIL\tMR_fail()\n",
-
- SharedSuccessLabel = "MR_shared_success_"
- ++ ProcLabelString ++ ":\n",
- SharedLastSuccessLabel = "MR_shared_success_last_"
- ++ ProcLabelString ++ ":\n",
-
- LabelStr = label_to_c_string(SharedLabel, yes),
- string.format("\tMR_GOTO_LABEL(%s);\n", [s(LabelStr)],
- GotoSharedLabel),
-
- CallDecls = [SaveStructDecl | Decls],
- CallComponents = [
- foreign_proc_inputs(InputDescs),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- InitSaveStruct),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SaveRegs),
- ProcLabelDefine,
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, CallDef1),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, CallDef2),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, CallDef3),
- foreign_proc_user_code(FirstContext, AffectsLiveness, First),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- GotoSharedLabel),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- CallSuccessLabel),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RestoreRegs),
- foreign_proc_outputs(OutputDescs),
- foreign_proc_raw_code(can_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- Succeed),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- CallLastSuccessLabel),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RestoreRegs),
- foreign_proc_outputs(OutputDescs),
- foreign_proc_raw_code(can_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SucceedDiscard),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef1),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef2),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef3),
- ProcLabelUndef
- ],
- CallBlockCode = singleton(
- llds_instr(foreign_proc_code(CallDecls, CallComponents,
- MayCallMercury, yes(SharedLabel), no, no, no, no, yes, MD),
- "Call foreign_proc inclusion")
- ),
-
- RetryDecls = [SaveStructDecl | OutDecls],
- RetryComponents = [
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- InitSaveStruct),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SaveRegs),
- ProcLabelDefine,
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, RetryDef1),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, RetryDef2),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, RetryDef3),
- foreign_proc_user_code(LaterContext, AffectsLiveness, Later),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- GotoSharedLabel),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RetrySuccessLabel),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RestoreRegs),
- foreign_proc_outputs(OutputDescs),
- foreign_proc_raw_code(can_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- Succeed),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RetryLastSuccessLabel),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RestoreRegs),
- foreign_proc_outputs(OutputDescs),
- foreign_proc_raw_code(can_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SucceedDiscard),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef1),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef2),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef3),
- ProcLabelUndef
- ],
- RetryBlockCode = singleton(
- llds_instr(foreign_proc_code(RetryDecls, RetryComponents,
- MayCallMercury, yes(SharedLabel), no, no, no, no, yes, MD),
- "Retry foreign_proc inclusion")
- ),
-
- SharedDecls = [SaveStructDecl | OutDecls],
- SharedComponents = [
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- InitSaveStruct),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SaveRegs),
- ProcLabelDefine,
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SharedDef1),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SharedDef2),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SharedDef3),
- foreign_proc_user_code(SharedContext, AffectsLiveness,
- Shared),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SharedSuccessLabel),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RestoreRegs),
- foreign_proc_outputs(OutputDescs),
- foreign_proc_raw_code(can_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- Succeed),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SharedLastSuccessLabel),
- foreign_proc_raw_code(can_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- RestoreRegs),
- foreign_proc_outputs(OutputDescs),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info,
- SucceedDiscard),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef1),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef2),
- foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, no_live_lvals_info, Undef3),
- ProcLabelUndef
- ],
- SharedBlockCode = singleton(
- llds_instr(foreign_proc_code(SharedDecls, SharedComponents,
- MayCallMercury, no, no, no, no, no, yes, MD),
- "Shared foreign_proc inclusion")
- ),
-
- Code = ModFrameCode ++ FirstDisjunctCode ++ CallBlockCode ++
- RetryLabelCode ++ LaterDisjunctCode ++ RetryBlockCode ++
- SharedLabelCode ++ SharedBlockCode
- ).
-
-%---------------------------------------------------------------------------%
-
:- type c_arg
---> c_arg(
prog_var,
Index: compiler/proc_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_gen.m,v
retrieving revision 1.37
diff -u -r1.37 proc_gen.m
--- compiler/proc_gen.m 30 Jul 2010 05:16:14 -0000 1.37
+++ compiler/proc_gen.m 23 Aug 2010 07:25:17 -0000
@@ -883,47 +883,17 @@
MaybeTraceInfo = no,
TraceFillCode = empty
),
- module_info_pred_info(ModuleInfo, PredId, PredInfo),
- ModuleName = pred_info_module(PredInfo),
- PredName = pred_info_name(PredInfo),
- Arity = pred_info_orig_arity(PredInfo),
PushMsg = push_msg(ModuleInfo, PredId, ProcId),
(
CodeModel = model_non,
resume_point_stack_addr(OutsideResumePoint, OutsideResumeAddress),
- (
- Goal = hlds_goal(call_foreign_proc(_, _, _, _, _, _, PragmaCode),
- _),
- PragmaCode = fc_impl_model_non(Fields, FieldsContext,
- _, _, _, _, _, _, _)
- ->
- StructName = foreign_proc_struct_name(ModuleName, PredName, Arity,
- ProcId),
- Struct = foreign_proc_struct(StructName, Fields, FieldsContext),
- string.format("#define\tMR_ORDINARY_SLOTS\t%d\n",
- [i(TotalSlots)], DefineStr),
- DefineComponents = [foreign_proc_raw_code(cannot_branch_away,
- proc_does_not_affect_liveness, live_lvals_info(set.init),
- DefineStr)],
- NondetFrameInfo = ordinary_frame(PushMsg, TotalSlots, yes(Struct)),
- MD = proc_may_not_duplicate,
- AllocCode = from_list([
- llds_instr(mkframe(NondetFrameInfo, yes(OutsideResumeAddress)),
- "Allocate stack frame"),
- llds_instr(foreign_proc_code([], DefineComponents,
- proc_will_not_call_mercury, no, no, no, no, no, no, MD),
- "")
- ]),
- NondetPragma = yes
- ;
- NondetFrameInfo = ordinary_frame(PushMsg, TotalSlots, no),
- AllocCode = singleton(
- llds_instr(mkframe(NondetFrameInfo, yes(OutsideResumeAddress)),
- "Allocate stack frame")
- ),
- NondetPragma = no
- )
+ NondetFrameInfo = ordinary_frame(PushMsg, TotalSlots, no),
+ AllocCode = singleton(
+ llds_instr(mkframe(NondetFrameInfo, yes(OutsideResumeAddress)),
+ "Allocate stack frame")
+ ),
+ NondetPragma = no
;
( CodeModel = model_det
; CodeModel = model_semi
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.222
diff -u -r1.222 prog_data.m
--- compiler/prog_data.m 4 Aug 2010 02:44:10 -0000 1.222
+++ compiler/prog_data.m 30 Aug 2010 06:41:46 -0000
@@ -815,9 +815,6 @@
% code in the Mercury program. The context is missing if the foreign code
% was constructed by the compiler.
%
- % NOTE: nondet pragma foreign definitions might not be possible in all
- % foreign languages.
- %
:- type pragma_foreign_code_impl
---> fc_impl_ordinary(
% This is a foreign language definition of a model_det or
@@ -827,45 +824,6 @@
string, % The code of the procedure.
maybe(prog_context)
- )
-
- ; fc_impl_model_non(
- % This is a foreign language definition of a model_non
- % procedure.
-
- % The info saved for the time when backtracking reenters
- % this procedure is stored in a data structure. This arg
- % contains the field declarations.
- string,
- maybe(prog_context),
-
- % Gives the code to be executed when the procedure is
- % called for the first time. This code may access the
- % input variables.
- string,
- maybe(prog_context),
-
- % Gives the code to be executed when control backtracks
- % into the procedure. This code may not access the input
- % variables.
- string,
- maybe(prog_context),
-
- % How should the shared code be treated during code generation.
- foreign_proc_shared_code_treatment,
-
- % Shared code that is executed after both the previous
- % code fragments. May not access the input variables.
- string,
- maybe(prog_context)
- )
-
- ; fc_impl_import(
- string, % Pragma imported C func name
- string, % Code to handle return value
- string, % Comma separated variables which the import
- % function is called with.
- maybe(prog_context)
).
% The use of this type is explained in the comment at the top of
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.140
diff -u -r1.140 prog_io_pragma.m
--- compiler/prog_io_pragma.m 8 Sep 2009 02:43:36 -0000 1.140
+++ compiler/prog_io_pragma.m 27 Aug 2010 03:39:33 -0000
@@ -409,20 +409,15 @@
:- pred parse_pragma_c_header_code(module_name::in, list(term)::in, term::in,
varset::in, prog_context::in, int::in, maybe1(item)::out) is det.
-parse_pragma_c_header_code(ModuleName, PragmaTerms, ErrorTerm, VarSet, Context,
- SeqNum, MaybeItem) :-
- ( PragmaTerms = [term.functor(_, _, Context) | _] ->
- LangC = term.functor(term.string("C"), [], Context),
- parse_pragma_foreign_decl_pragma(ModuleName, "c_header_code",
- [LangC | PragmaTerms], ErrorTerm, VarSet, Context, SeqNum,
- MaybeItem)
- ;
- Pieces = [words("Error: wrong number or unexpected variable in"),
- quote(":- pragma c_header_code"), words("declaration."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(ErrorTerm), [always(Pieces)])]),
- MaybeItem = error1([Spec])
- ).
+parse_pragma_c_header_code(_, _, ErrorTerm, _, _, _, MaybeItem) :-
+ Pieces = [
+ words("Error:"), quote(":- pragma c_header_code"),
+ words("declarations are no longer supported. Please use a"),
+ quote(":- pragma foreign_decl"), words("declaration for C instead.")
+ ],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(ErrorTerm), [always(Pieces)])]),
+ MaybeItem = error1([Spec]).
%----------------------------------------------------------------------------%
%
@@ -767,8 +762,7 @@
:- pred parse_pragma_c_code(module_name::in, list(term)::in, term::in,
varset::in, prog_context::in, int::in, maybe1(item)::out) is det.
-parse_pragma_c_code(ModuleName, PragmaTerms, ErrorTerm, VarSet, Context,
- SeqNum, MaybeItem) :-
+parse_pragma_c_code(_, PragmaTerms, ErrorTerm, _, _, _, MaybeItem) :-
% pragma c_code is almost as if we have written foreign_code
% or foreign_proc with the language set to "C".
% There are a few differences (error messages, some deprecated
@@ -776,50 +770,49 @@
% pragma name to parse_pragma_foreign_code_pragma.
(
% arity = 1 (same as foreign_code)
- PragmaTerms = [term.functor(_, _, FirstContext)]
+ PragmaTerms = [_]
->
- LangC = term.functor(term.string("C"), [], FirstContext),
- parse_pragma_foreign_code_pragma(ModuleName, "c_code",
- [LangC | PragmaTerms], ErrorTerm, VarSet, Context, SeqNum,
- MaybeItem)
+ Pieces = [
+ words("Error:"), quote(":- pragma c_code"),
+ words("declarations are no longer supported. Please use a"),
+ quote(":- pragma foreign_code"),
+ words("declaration for C instead.")
+ ]
;
% arity > 1 (same as foreign_proc)
- PragmaTerms = [term.functor(_, _, FirstContext) | _]
+ PragmaTerms = [_ | _]
->
- LangC = term.functor(term.string("C"), [], FirstContext),
- parse_pragma_foreign_proc_pragma(ModuleName, "c_code",
- [LangC | PragmaTerms], ErrorTerm, VarSet, Context, SeqNum,
- MaybeItem)
- ;
- Pieces = [words("Error: wrong number of arguments"),
- words("or unexpected variable in"),
- quote(":- pragma c_code"), words("declaration."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(ErrorTerm), [always(Pieces)])]),
- MaybeItem = error1([Spec])
- ).
+ Pieces = [
+ words("Error:"), quote(":- pragma c_code"),
+ words("declarations are no longer supported. Please use a"),
+ quote(":- pragma foreign_proc"),
+ words("declaration for C instead.")
+ ]
+ ;
+ Pieces = [
+ words("Error:"), quote(":- pragma c_code"),
+ words("declarations are no longer supported. Please use a"),
+ quote(":- pragma foreign_code"), words("or"),
+ quote(":- pragma foreign_proc"),
+ words("declaration for C instead.")
+ ]
+ ),
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(ErrorTerm), [always(Pieces)])]),
+ MaybeItem = error1([Spec]).
:- pred parse_pragma_c_import_module(list(term)::in, term::in,
prog_context::in, int::in, maybe1(item)::out) is det.
-parse_pragma_c_import_module(PragmaTerms, ErrorTerm, Context, SeqNum,
- MaybeItem) :-
- (
- PragmaTerms = [ImportTerm],
- try_parse_sym_name_and_no_args(ImportTerm, Import)
- ->
- Pragma = pragma_foreign_import_module(lang_c, Import),
- ItemPragma = item_pragma_info(user, Pragma, Context, SeqNum),
- Item = item_pragma(ItemPragma),
- MaybeItem = ok1(Item)
- ;
- Pieces = [words("Error: wrong number of arguments"),
- words("or invalid module name in"),
- quote(":- pragma c_import_module"), words("declaration."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(ErrorTerm), [always(Pieces)])]),
- MaybeItem = error1([Spec])
- ).
+parse_pragma_c_import_module(_, ErrorTerm, _, _, MaybeItem) :-
+ Pieces = [
+ words("Error:"), quote(":- pragma c_import_module"),
+ words("declarations are no longer supported. Please use a"),
+ quote(":- pragma foreign_import_module"), words("declaration for C instead.")
+ ],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(ErrorTerm), [always(Pieces)])]),
+ MaybeItem = error1([Spec]).
:- pred parse_pragma_foreign_import_module(list(term)::in, term::in,
prog_context::in, int::in, maybe1(item)::out) is det.
@@ -856,107 +849,29 @@
:- pred parse_pragma_import(module_name::in, list(term)::in, term::in,
varset::in, prog_context::in, int::in, maybe1(item)::out) is det.
-parse_pragma_import(ModuleName, PragmaTerms, ErrorTerm, VarSet, Context,
- SeqNum, MaybeItem) :-
- % XXX We assume all imports are C.
- ForeignLanguage = lang_c,
- (
- (
- PragmaTerms = [PredAndModesTerm, FlagsTerm, FunctionTerm],
- FlagsContextPieces = [words("In second argument of"),
- quote(":- pragma import/3"), words("declaration:")],
- parse_pragma_foreign_proc_attributes_term(ForeignLanguage,
- "import", VarSet, FlagsTerm, FlagsContextPieces,
- MaybeAttributes)
- ;
- PragmaTerms = [PredAndModesTerm, FunctionTerm],
- Flags0 = default_attributes(ForeignLanguage),
- % Pragma import uses legacy purity behaviour.
- set_legacy_purity_behaviour(yes, Flags0, Flags),
- MaybeAttributes = ok1(Flags)
- )
- ->
- ( FunctionTerm = term.functor(term.string(Function), [], _) ->
- PredAndModesContextPieces = [words("In"),
- quote(":- pragma import"), words("declaration:")],
- parse_pred_or_func_and_arg_modes(yes(ModuleName), PredAndModesTerm,
- ErrorTerm, VarSet, PredAndModesContextPieces,
- MaybePredAndArgModes),
- (
- MaybePredAndArgModes = ok2(PredName - PredOrFunc, ArgModes),
- (
- MaybeAttributes = ok1(Attributes),
- Pragma = pragma_import(PredName, PredOrFunc, ArgModes,
- Attributes, Function),
- ItemPragma = item_pragma_info(user, Pragma, Context,
- SeqNum),
- Item = item_pragma(ItemPragma),
- MaybeItem = ok1(Item)
- ;
- MaybeAttributes = error1(FlagsSpecs),
- MaybeItem = error1(FlagsSpecs)
- )
- ;
- MaybePredAndArgModes = error2(Specs),
- MaybeItem = error1(Specs)
- )
- ;
- Pieces = [words("Error: expected pragma"),
- words("import(PredName(ModeList), Function)."), nl],
- % XXX Should we use FunctionTerm's context?
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(PredAndModesTerm),
- [always(Pieces)])]),
- MaybeItem = error1([Spec])
- )
- ;
- Pieces = [words("Error: wrong number of arguments in"),
- quote(":- pragma import"), words("declaration."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(ErrorTerm), [always(Pieces)])]),
- MaybeItem = error1([Spec])
- ).
+parse_pragma_import(_, _, ErrorTerm, _, _, _, MaybeItem) :-
+ Pieces = [
+ words("Error:"), quote(":- pragma import"),
+ words("declarations are no longer supported. Please use a"),
+ quote(":- pragma foreign_proc"), words("declaration for C instead.")
+ ],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(ErrorTerm), [always(Pieces)])]),
+ MaybeItem = error1([Spec]).
:- pred parse_pragma_export(list(term)::in, term::in, varset::in,
prog_context::in, int::in, maybe1(item)::out) is det.
-parse_pragma_export(PragmaTerms, ErrorTerm, VarSet, Context, SeqNum,
- MaybeItem) :-
- ( PragmaTerms = [PredAndModesTerm, FunctionTerm] ->
- ( FunctionTerm = term.functor(term.string(Function), [], _) ->
- ContextPieces = [words("In"), quote(":- pragma export"),
- words("declaration:")],
- parse_pred_or_func_and_arg_modes(no, PredAndModesTerm, ErrorTerm,
- VarSet, ContextPieces, MaybePredAndModes),
- (
- MaybePredAndModes = ok2(PredName - PredOrFunc, Modes),
- Pragma = pragma_foreign_export(lang_c, PredName, PredOrFunc,
- Modes, Function),
- ItemPragma = item_pragma_info(user, Pragma, Context, SeqNum),
- Item = item_pragma(ItemPragma),
- MaybeItem = ok1(Item)
- ;
- MaybePredAndModes = error2(Specs),
- MaybeItem = error1(Specs)
- )
- ;
- % XXX Why this wording?
- Pieces = [words("Error: expected pragma"),
- words("export(PredName(ModeList), Function)."), nl],
- % Should we use FunctionTerm's context?
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(PredAndModesTerm),
- [always(Pieces)])]),
- MaybeItem = error1([Spec])
- )
- ;
- Pieces = [words("Error: wrong number of arguments in"),
- quote(":- pragma export"), words("declaration."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(ErrorTerm), [always(Pieces)])]),
- MaybeItem = error1([Spec])
- ).
-
+parse_pragma_export(_, ErrorTerm, _, _, _, MaybeItem) :-
+ Pieces = [
+ words("Error:"), quote(":- pragma export"),
+ words("declarations are no longer supported. Please use a"),
+ quote(":- pragma foreign_export"), words("declaration for C instead.")
+ ],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(ErrorTerm), [always(Pieces)])]),
+ MaybeItem = error1([Spec]).
+
:- pred parse_pragma_unused_args(module_name::in, list(term)::in, term::in,
varset::in, prog_context::in, int::in, maybe1(item)::out) is det.
@@ -1819,26 +1734,6 @@
PragmaName, VarSet, PredAndVarsTerm, FlagsTerm, CodeTerm,
ForeignLanguage, InvalidDeclPrefix, Context, SeqNum,
MaybeRestItem)
- ;
- RestTerms = [PredAndVarsTerm, FlagsTerm, FieldsTerm,
- FirstTerm, LaterTerm],
- term.context_init(DummyContext),
- SharedTerm = term.functor(term.atom("common_code"),
- [term.functor(term.string(""), [], DummyContext)],
- DummyContext),
- parse_pragma_model_non_foreign_proc_pragma(ModuleName,
- PragmaName, VarSet, PredAndVarsTerm, FlagsTerm,
- FieldsTerm, FirstTerm, LaterTerm, SharedTerm,
- ForeignLanguage, InvalidDeclPrefix, Context, SeqNum,
- MaybeRestItem)
- ;
- RestTerms = [PredAndVarsTerm, FlagsTerm, FieldsTerm,
- FirstTerm, LaterTerm, SharedTerm],
- parse_pragma_model_non_foreign_proc_pragma(ModuleName,
- PragmaName, VarSet, PredAndVarsTerm, FlagsTerm,
- FieldsTerm, FirstTerm, LaterTerm, SharedTerm,
- ForeignLanguage, InvalidDeclPrefix, Context, SeqNum,
- MaybeRestItem)
)
->
(
@@ -1977,127 +1872,6 @@
MaybeItem = error1(Specs)
).
-:- pred parse_pragma_model_non_foreign_proc_pragma(module_name::in, string::in,
- varset::in, term::in, term::in, term::in, term::in, term::in,
- term::in, foreign_language::in, list(format_component)::in,
- prog_context::in, int::in, maybe1(item)::out) is det.
-
-parse_pragma_model_non_foreign_proc_pragma(ModuleName, PragmaName, VarSet,
- PredAndVarsTerm, FlagsTerm, FieldsTerm, FirstTerm, LaterTerm,
- SharedTerm, ForeignLanguage, InvalidDeclPrefix, Context, SeqNum,
- MaybeItem) :-
- FlagsContextPieces = InvalidDeclPrefix ++
- [lower_case_next_if_not_first, words("Invalid third argument:")],
- parse_pragma_foreign_proc_attributes_term(ForeignLanguage, PragmaName,
- VarSet, FlagsTerm, FlagsContextPieces, MaybeFlags),
- (
- MaybeFlags = ok1(Flags),
- FlagsSpecs = []
- ;
- MaybeFlags = error1(FlagsSpecs),
- Flags = default_attributes(ForeignLanguage) % Dummy
- ),
- (
- parse_pragma_keyword("local_vars", FieldsTerm,
- FieldsPrime, FieldsContextPrime)
- ->
- Fields = FieldsPrime,
- FieldsContext = FieldsContextPrime,
- LocalSpecs = []
- ;
- Fields = "", % Dummy
- FieldsContext = get_term_context(FieldsTerm),
- LocalPieces = InvalidDeclPrefix ++
- [words("invalid fourth argument, expecting"),
- quote("local_vars(<fields>)"), suffix("."), nl],
- LocalSpec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(FieldsContext, [always(LocalPieces)])]),
- LocalSpecs = [LocalSpec]
- ),
- (
- parse_pragma_keyword("first_code", FirstTerm,
- FirstPrime, FirstContextPrime)
- ->
- First = FirstPrime,
- FirstContext = FirstContextPrime,
- FirstSpecs = []
- ;
- First = "", % Dummy
- FirstContext = get_term_context(FirstTerm),
- FirstPieces = InvalidDeclPrefix ++
- [words("invalid fifth argument, expecting"),
- quote("first_code(<code>)"), suffix("."), nl],
- FirstSpec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(FirstContext, [always(FirstPieces)])]),
- FirstSpecs = [FirstSpec]
- ),
- (
- parse_pragma_keyword("retry_code", LaterTerm,
- LaterPrime, LaterContextPrime)
- ->
- Later = LaterPrime,
- LaterContext = LaterContextPrime,
- LaterSpecs = []
- ;
- Later = "", % Dummy
- LaterContext = get_term_context(LaterTerm),
- LaterPieces = InvalidDeclPrefix ++
- [words("invalid sixth argument, expecting"),
- quote("retry_code(<code>)"), suffix("."), nl],
- LaterSpec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(LaterTerm), [always(LaterPieces)])]),
- LaterSpecs = [LaterSpec]
- ),
- (
- parse_pragma_keyword("shared_code", SharedTerm,
- SharedPrime, SharedContextPrime)
- ->
- Shared = SharedPrime,
- SharedContext = SharedContextPrime,
- Treatment = shared_code_share,
- SharedSpecs = []
- ;
- parse_pragma_keyword("duplicated_code", SharedTerm,
- SharedPrime, SharedContextPrime)
- ->
- Shared = SharedPrime,
- SharedContext = SharedContextPrime,
- Treatment = shared_code_duplicate,
- SharedSpecs = []
- ;
- parse_pragma_keyword("common_code", SharedTerm,
- SharedPrime, SharedContextPrime)
- ->
- Shared = SharedPrime,
- SharedContext = SharedContextPrime,
- Treatment = shared_code_automatic,
- SharedSpecs = []
- ;
- Shared = "", % Dummy
- SharedContext = term.context_init, % Dummy
- Treatment = shared_code_automatic, % Dummy
- SharedPieces = InvalidDeclPrefix ++
- [words("invalid seventh argument, expecting"),
- quote("common_code(<code>)"), suffix("."), nl],
- SharedSpec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(SharedTerm),
- [always(SharedPieces)])]),
- SharedSpecs = [SharedSpec]
- ),
- Specs =
- FlagsSpecs ++ LocalSpecs ++ FirstSpecs ++ LaterSpecs ++ SharedSpecs,
- (
- Specs = [],
- Impl = fc_impl_model_non(Fields, yes(FieldsContext),
- First, yes(FirstContext), Later, yes(LaterContext),
- Treatment, Shared, yes(SharedContext)),
- parse_pragma_foreign_code(ModuleName, Flags, PredAndVarsTerm,
- Impl, VarSet, Context, SeqNum, MaybeItem)
- ;
- Specs = [_ | _],
- MaybeItem = error1(Specs)
- ).
-
% This parses a pragma that refers to a predicate or function.
%
:- pred parse_simple_pragma(module_name::in, string::in,
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.39
diff -u -r1.39 prog_item.m
--- compiler/prog_item.m 5 Nov 2009 06:34:41 -0000 1.39
+++ compiler/prog_item.m 30 Aug 2010 06:45:51 -0000
@@ -493,19 +493,7 @@
exp_foreign_name :: string
% Predname, Predicate/function, Modes, foreign function name.
)
-
- ; pragma_import(
- import_pred_name :: sym_name,
- import_p_or_f :: pred_or_func,
- import_modes :: list(mer_mode),
- import_attrs :: pragma_foreign_proc_attributes,
- import_foreign_name :: string
- % Predname, Predicate/function, Modes,
- % Set of foreign proc attributes, eg.:
- % whether or not the foreign code may call Mercury,
- % whether or not the foreign code is thread-safe
- % foreign function name.
- )
+
;
pragma_foreign_export_enum(
export_enum_language :: foreign_language,
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.71
diff -u -r1.71 recompilation.version.m
--- compiler/recompilation.version.m 5 Nov 2009 06:34:41 -0000 1.71
+++ compiler/recompilation.version.m 30 Aug 2010 07:07:02 -0000
@@ -619,7 +619,6 @@
yes(yes(PredOrFunc) - Name / Arity)) :-
adjust_func_arity(PredOrFunc, Arity, list.length(Modes)).
% Pragma import declarations are never used directly by Mercury code.
-is_pred_pragma(pragma_import(_, _, _, _, _), no).
is_pred_pragma(pragma_foreign_export_enum(_, _, _, _, _), no).
is_pred_pragma(pragma_foreign_enum(_, _, _, _), no).
is_pred_pragma(pragma_source_file(_), no).
Index: tests/debugger/existential_type_classes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/existential_type_classes.m,v
retrieving revision 1.7
diff -u -r1.7 existential_type_classes.m
--- tests/debugger/existential_type_classes.m 14 Oct 2005 01:42:53 -0000 1.7
+++ tests/debugger/existential_type_classes.m 30 Aug 2010 13:57:39 -0000
@@ -73,9 +73,9 @@
my_exist_t = 43.
-:- pragma c_code(
+:- pragma foreign_proc("C",
my_univ_value(Univ::in) = (Value::out),
- [will_not_call_mercury],
+ [will_not_call_mercury, promise_pure],
"
/* mention TypeInfo_for_T */
TypeClassInfo_for_existential_type_classes__fooable_T =
@@ -83,9 +83,9 @@
Value = MR_field(MR_UNIV_TAG, Univ, 1);
").
-:- pragma c_code(
+:- pragma foreign_proc("C",
my_univ(Value::in) = (Univ::out),
- [will_not_call_mercury],
+ [will_not_call_mercury, promise_pure],
"
MR_tag_incr_hp(Univ, MR_UNIV_TAG, 2);
MR_field(MR_UNIV_TAG, Univ, 0) =
Index: tests/debugger/io_tab_goto.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/io_tab_goto.m,v
retrieving revision 1.1
diff -u -r1.1 io_tab_goto.m
--- tests/debugger/io_tab_goto.m 16 Sep 2005 05:42:55 -0000 1.1
+++ tests/debugger/io_tab_goto.m 30 Aug 2010 13:55:31 -0000
@@ -80,7 +80,7 @@
{ N = SoFar }
).
-:- pragma c_header_code("#include <stdio.h>").
+:- pragma foreign_decl("C", "#include <stdio.h>").
:- pred io_tab_goto.open_input(string::in, int::out, c_pointer::out,
io.state::di, io.state::uo) is det.
Index: tests/debugger/print_io_actions.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/print_io_actions.m,v
retrieving revision 1.1
diff -u -r1.1 print_io_actions.m
--- tests/debugger/print_io_actions.m 27 Sep 2007 07:28:23 -0000 1.1
+++ tests/debugger/print_io_actions.m 30 Aug 2010 13:55:51 -0000
@@ -46,7 +46,7 @@
)
).
-:- pragma c_header_code("#include <stdio.h>").
+:- pragma foreign_decl("C", "#include <stdio.h>").
:- pred fake_open_input(string::in, int::out, c_pointer::out, io::di, io::uo)
is det.
Index: tests/debugger/tabled_read.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/tabled_read.m,v
retrieving revision 1.3
diff -u -r1.3 tabled_read.m
--- tests/debugger/tabled_read.m 20 Feb 2002 03:14:45 -0000 1.3
+++ tests/debugger/tabled_read.m 30 Aug 2010 13:54:48 -0000
@@ -70,7 +70,7 @@
{ N = SoFar }
).
-:- pragma c_header_code("#include <stdio.h>").
+:- pragma foreign_decl("C", "#include <stdio.h>").
:- pred tabled_read__open_input(string::in, int::out, c_pointer::out,
io__state::di, io__state::uo) is det.
Index: tests/debugger/tabled_read_decl.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/tabled_read_decl.m,v
retrieving revision 1.1
diff -u -r1.1 tabled_read_decl.m
--- tests/debugger/tabled_read_decl.m 20 Feb 2002 03:14:47 -0000 1.1
+++ tests/debugger/tabled_read_decl.m 30 Aug 2010 13:56:02 -0000
@@ -70,7 +70,7 @@
{ N = SoFar }
).
-:- pragma c_header_code("#include <stdio.h>").
+:- pragma foreign_decl("C", "#include <stdio.h>").
:- pred tabled_read_decl__open_input(string::in, int::out, c_pointer::out,
io__state::di, io__state::uo) is det.
Index: tests/debugger/tabled_read_unitize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/tabled_read_unitize.m,v
retrieving revision 1.2
diff -u -r1.2 tabled_read_unitize.m
--- tests/debugger/tabled_read_unitize.m 29 Aug 2002 00:56:38 -0000 1.2
+++ tests/debugger/tabled_read_unitize.m 30 Aug 2010 13:56:29 -0000
@@ -28,7 +28,7 @@
io__write_string("could not open tabled_read_unitize.data\n")
).
-:- pragma export(tabled_read_unitize__read_num(in, out, di, uo),
+:- pragma foreign_export("C", tabled_read_unitize__read_num(in, out, di, uo),
"MT_read_num").
:- pred tabled_read_unitize__read_num(c_pointer::in, int::out,
@@ -72,7 +72,7 @@
N = int1 * 100 + int2;
").
-:- pragma c_header_code("#include <stdio.h>").
+:- pragma foreign_decl("C", "#include <stdio.h>").
:- pred tabled_read_unitize__open_input(string::in, int::out, c_pointer::out,
io__state::di, io__state::uo) is det.
Index: tests/debugger/declarative/tabled_read_decl.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/declarative/tabled_read_decl.m,v
retrieving revision 1.4
diff -u -r1.4 tabled_read_decl.m
--- tests/debugger/declarative/tabled_read_decl.m 27 Sep 2007 07:28:26 -0000 1.4
+++ tests/debugger/declarative/tabled_read_decl.m 30 Aug 2010 13:58:14 -0000
@@ -90,7 +90,7 @@
N = SoFar
).
-:- pragma c_header_code("#include <stdio.h>").
+:- pragma foreign_decl("C", "#include <stdio.h>").
:- pred tabled_read_decl.open_input(string::in, int::out, c_pointer::out,
io::di, io::uo) is det.
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.389
diff -u -r1.389 Mmakefile
--- tests/hard_coded/Mmakefile 19 Aug 2010 06:33:42 -0000 1.389
+++ tests/hard_coded/Mmakefile 31 Aug 2010 01:28:06 -0000
@@ -449,7 +449,6 @@
factt_sort_test \
foreign_type_assertion \
pragma_export \
- pragma_import \
runtime_opt
else
C_ONLY_PROGS =
@@ -621,34 +620,6 @@
BACKEND_PROGS =
endif
-# The MLDS back-end doesn't support nondet C in trailing grades,
-# or in no-GC grades (except with --no-reclaim-heap-on-failure).
-# We also don't support nondet C in deep profiling grades.
-# These tests are also not supported in IL, Java and Erlang grades,
-# since those back-ends don't support the C interface at all.
-# (XXX perhaps we should add analogous tests of the nondet IL, C#, MC++,
-# and [eventually] Java interfaces?)
-ifneq "$(filter il% java% erlang%,$(GRADE))" ""
- NONDET_C_PROGS =
-else
- ifeq "$(findstring hl,$(GRADE))$(findstring .tr,$(GRADE))" "hl.tr"
- NONDET_C_PROGS =
- else
- ifeq "$(findstring hl,$(GRADE))$(findstring .gc,$(GRADE))" "hl"
- NONDET_C_PROGS =
- else
- ifneq "$(findstring profdeep,$(GRADE))" ""
- NONDET_C_PROGS =
- else
- NONDET_C_PROGS = \
- inline_nondet_pragma_c \
- nondet_c \
- nondet_pragma_c_bug
- endif
- endif
- endif
-endif
-
# string_hash tests features of the Mercury C runtime.
# It requires too much memory to be used in non-GC grades.
ifeq "$(filter il% java%,$(GRADE))$(findstring gc,$(GRADE))" "gc"
@@ -678,7 +649,7 @@
# We currently test only a limited selection in grade java on this directory.
PROGS = $(ORDINARY_PROGS) $(PROF_PROGS) $(BROKEN_FOR_LCC_PROGS) \
$(CLOSURE_LAYOUT_PROGS) $(NON_PROFDEEP_PROGS) \
- $(BACKEND_PROGS) $(NONDET_C_PROGS) \
+ $(BACKEND_PROGS) \
$(C_AND_GC_ONLY_PROGS) $(STATIC_LINK_PROGS) \
$(CHAR_REP_PROGS) $(C_ONLY_PROGS) \
$(DOTNET_PROGS) $(JAVA_PROGS) $(SOLVER_PROGS) \
Index: tests/hard_coded/constraint_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/constraint_order.m,v
retrieving revision 1.5
diff -u -r1.5 constraint_order.m
--- tests/hard_coded/constraint_order.m 14 Aug 2009 03:21:54 -0000 1.5
+++ tests/hard_coded/constraint_order.m 30 Aug 2010 14:00:15 -0000
@@ -39,7 +39,7 @@
:- impure pred puts(string::in) is det.
-:- pragma c_code(puts(Str::in), "puts(Str);").
+:- pragma foreign_proc("C", puts(Str::in), [], "puts(Str);").
:- pragma foreign_proc("C#", puts(Str::in), [],
"System.Console.WriteLine(Str);").
:- pragma foreign_proc("Java", puts(Str::in), [],
Index: tests/hard_coded/copy_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/copy_pred.m,v
retrieving revision 1.5
diff -u -r1.5 copy_pred.m
--- tests/hard_coded/copy_pred.m 6 Jun 2007 01:48:10 -0000 1.5
+++ tests/hard_coded/copy_pred.m 30 Aug 2010 13:46:06 -0000
@@ -21,8 +21,9 @@
:- pred inst_cast(pred(string, string), pred(string, string)).
:- mode inst_cast(in, out(pred(in, out) is det)) is det.
- :- pragma c_code(inst_cast(X::in, Y::out(pred(in, out) is det)),
- [will_not_call_mercury, thread_safe], "Y = X").
+ :- pragma foreign_proc("C",
+ inst_cast(X::in, Y::out(pred(in, out) is det)),
+ [will_not_call_mercury, thread_safe, promise_pure], "Y = X").
:- pragma foreign_proc("C#",
inst_cast(X::in, Y::out(pred(in, out) is det)),
[will_not_call_mercury, thread_safe, promise_pure], "Y = X;").
Index: tests/hard_coded/copy_pred_2.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/copy_pred_2.m,v
retrieving revision 1.5
diff -u -r1.5 copy_pred_2.m
--- tests/hard_coded/copy_pred_2.m 14 Aug 2009 03:21:54 -0000 1.5
+++ tests/hard_coded/copy_pred_2.m 30 Aug 2010 13:48:24 -0000
@@ -29,8 +29,9 @@
:- pred inst_cast(pred(string, string), pred(string, string)).
:- mode inst_cast(in, out(pred(in, out) is det)) is det.
-:- pragma c_code(inst_cast(X::in, Y::out(pred(in, out) is det)),
- [will_not_call_mercury, thread_safe], "Y = X").
+:- pragma foreign_proc("C",
+ inst_cast(X::in, Y::out(pred(in, out) is det)),
+ [will_not_call_mercury, thread_safe, promise_pure], "Y = X").
:- pragma foreign_proc("C#",
inst_cast(X::in, Y::out(pred(in, out) is det)),
[will_not_call_mercury, thread_safe, promise_pure], "Y = X;").
Index: tests/hard_coded/export_test.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/export_test.m,v
retrieving revision 1.7
diff -u -r1.7 export_test.m
--- tests/hard_coded/export_test.m 14 Aug 2009 03:21:54 -0000 1.7
+++ tests/hard_coded/export_test.m 30 Aug 2010 13:45:16 -0000
@@ -23,10 +23,12 @@
foo(X, X+1).
-:- pragma export(foo(in, out), "foo").
+:- pragma foreign_export("C", foo(in, out), "foo").
:- pragma foreign_export("Java", foo(in, out), "foo").
-:- pragma c_code(bar(X::in, Y::out), may_call_mercury,
+:- pragma foreign_proc("C",
+ bar(X::in, Y::out),
+ [promise_pure, may_call_mercury],
"
foo(X, &Y);
").
Index: tests/hard_coded/foreign_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/foreign_type.m,v
retrieving revision 1.7
diff -u -r1.7 foreign_type.m
--- tests/hard_coded/foreign_type.m 2 Jul 2003 06:40:53 -0000 1.7
+++ tests/hard_coded/foreign_type.m 30 Aug 2010 13:49:11 -0000
@@ -11,10 +11,10 @@
:- type coord.
:- func new(int, int) = coord.
-:- pragma export(new(in, in) = out, "exported_new").
+:- pragma foreign_export("C", new(in, in) = out, "exported_new").
:- pred newpred(int::in, int::in, coord::out) is det.
-:- pragma export(newpred(in, in, out), "exported_newpred").
+:- pragma foreign_export("C", newpred(in, in, out), "exported_newpred").
:- func export_new(int, int) = coord.
:- pred export_newpred(int::in, int::in, coord::out) is det.
Index: tests/hard_coded/frameopt_pragma_redirect.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/frameopt_pragma_redirect.m,v
retrieving revision 1.3
diff -u -r1.3 frameopt_pragma_redirect.m
--- tests/hard_coded/frameopt_pragma_redirect.m 29 Mar 2006 08:08:01 -0000 1.3
+++ tests/hard_coded/frameopt_pragma_redirect.m 30 Aug 2010 13:49:56 -0000
@@ -57,8 +57,8 @@
:- pragma inline(is_invalid/1).
-:- pragma c_code(is_invalid(X :: in),
- [will_not_call_mercury, thread_safe],
+:- pragma foreign_proc("C", is_invalid(X :: in),
+ [will_not_call_mercury, thread_safe, promise_pure],
"SUCCESS_INDICATOR = X > 50;").
is_invalid(X) :- X > 50.
Index: tests/hard_coded/inline_nondet_pragma_c.exp
===================================================================
RCS file: tests/hard_coded/inline_nondet_pragma_c.exp
diff -N tests/hard_coded/inline_nondet_pragma_c.exp
--- tests/hard_coded/inline_nondet_pragma_c.exp 17 May 2000 07:18:26 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,2 +0,0 @@
-[10, 20, 42, 99]
-[1 - (10 - 1), 1 - (10 - 2), 1 - (20 - 1), 1 - (20 - 2), 1 - (42 - 1), 1 - (42 - 2), 1 - (99 - 1), 1 - (99 - 2), 2 - (10 - 1), 2 - (10 - 2), 2 - (20 - 1), 2 - (20 - 2), 2 - (42 - 1), 2 - (42 - 2), 2 - (99 - 1), 2 - (99 - 2)]
Index: tests/hard_coded/inline_nondet_pragma_c.m
===================================================================
RCS file: tests/hard_coded/inline_nondet_pragma_c.m
diff -N tests/hard_coded/inline_nondet_pragma_c.m
--- tests/hard_coded/inline_nondet_pragma_c.m 29 Mar 2006 08:08:01 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,49 +0,0 @@
-
-:- module inline_nondet_pragma_c.
-:- interface.
-:- import_module io.
-
-:- pred main(io__state::di, io__state::uo) is det.
-
-:- implementation.
-:- import_module pair, solutions.
-
-main -->
- { solutions(foo, FooList) },
- print(FooList), nl,
- { solutions(bar, List) },
- print(List), nl.
-
-:- pred bar(pair(int, pair(int, int))::out) is multi.
-bar(X - (Y - Z)) :-
- ( X = 1 ; X = 2),
- foo(Y),
- ( Z = 1 ; Z = 2).
-
-%
-% This example implements the equivalent of
-% foo(X) :- X = 20 ; X = 10 ; X = 42 ; X = 99 ; fail.
-%
-:- pred foo(int).
-:- mode foo(out) is multi.
-:- pragma inline(foo/1).
-:- pragma c_code(foo(X::out), [will_not_call_mercury, thread_safe],
- local_vars("
- int state;
- "),
- first_code("
- LOCALS->state = 1;
- "),
- retry_code("
- LOCALS->state++;
- "),
- common_code("
- switch (LOCALS->state) {
- case 1: X = 20; SUCCEED; break;
- case 2: X = 10; SUCCEED; break;
- case 3: X = 42; SUCCEED; break;
- case 4: X = 99; SUCCEED; break;
- case 5: FAIL; break;
- }
- ")
-).
Index: tests/hard_coded/mode_choice.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/mode_choice.m,v
retrieving revision 1.6
diff -u -r1.6 mode_choice.m
--- tests/hard_coded/mode_choice.m 14 Aug 2009 03:21:54 -0000 1.6
+++ tests/hard_coded/mode_choice.m 31 Aug 2010 01:43:21 -0000
@@ -60,7 +60,10 @@
:- pragma promise_pure(test1/3).
-:- pragma c_code(test1(_A::in, B::out, C::out), will_not_call_mercury, "
+:- pragma foreign_proc("C",
+ test1(_A::in, B::out, C::out),
+ [promise_pure, will_not_call_mercury],
+"
MR_make_aligned_string_copy(B, ""test1(in, out, out)"");
C = B;
SUCCESS_INDICATOR = MR_TRUE;
@@ -69,7 +72,10 @@
B = C,
B = "test1(in, out, out)".
-:- pragma c_code(test1(_A::in, _B::in, C::out), will_not_call_mercury, "
+:- pragma foreign_proc("C",
+ test1(_A::in, _B::in, C::out),
+ [promise_pure, will_not_call_mercury],
+"
MR_make_aligned_string_copy(C, ""test1(in, in, out)"");
SUCCESS_INDICATOR = MR_TRUE;
").
@@ -84,13 +90,19 @@
:- mode test2(di, uo) is det.
:- pragma promise_pure(test2/2).
-:- pragma c_code(test2(_A::in, B::out), will_not_call_mercury, "
+:- pragma foreign_proc("C",
+ test2(_A::in, B::out),
+ [promise_pure, will_not_call_mercury],
+"
MR_make_aligned_string_copy(B, ""test2(in, out)"");
").
test2(_A::in, B::out) :-
B = "test2(in, out)".
-:- pragma c_code(test2(_A::di, B::uo), will_not_call_mercury, "
+:- pragma foreign_proc("C",
+ test2(_A::di, B::uo),
+ [promise_pure, will_not_call_mercury],
+"
MR_make_aligned_string_copy(B, ""test2(di, uo)"");
").
test2(_A::di, B::uo) :-
@@ -113,7 +125,7 @@
*******/
:- pred mkany(string::out(any)) is det.
-:- pragma c_code(mkany(S::out(any)), will_not_call_mercury, "
+:- pragma foreign_proc("C", mkany(S::out(any)), [promise_pure, will_not_call_mercury], "
S = NULL;
").
:- pragma foreign_proc("C#", mkany(S::out(any)), [promise_pure], "
@@ -134,13 +146,19 @@
:- mode test3(out(any), out) is det.
:- pragma promise_pure(test3/2).
-:- pragma c_code(test3(_A::in(any), B::out), will_not_call_mercury, "
+:- pragma foreign_proc("C",
+ test3(_A::in(any), B::out),
+ [promise_pure, will_not_call_mercury],
+"
MR_make_aligned_string_copy(B, ""test3(in(any), out)"");
").
test3(_A::in(any), B::out) :-
B = "test3(in(any), out)".
-:- pragma c_code(test3(A::out(any), B::out), will_not_call_mercury, "
+:- pragma foreign_proc("C",
+ test3(A::out(any), B::out),
+ [promise_pure, will_not_call_mercury],
+"
A = NULL;
MR_make_aligned_string_copy(B, ""test3(out(any), out)"");
").
@@ -155,7 +173,10 @@
:- mode test4(out, in, out) is det.
:- pragma promise_pure(test4/3).
-:- pragma c_code(test4(_A::in, B::out, C::out), will_not_call_mercury, "
+:- pragma foreign_proc("C",
+ test4(_A::in, B::out, C::out),
+ [promise_pure, will_not_call_mercury],
+"
MR_make_aligned_string_copy(B, """");
MR_make_aligned_string_copy(C, ""test4(in, out, out)"");
").
@@ -163,7 +184,9 @@
B = "",
C = "test4(in, out, out)".
-:- pragma c_code(test4(A::out, _B::in, C::out), will_not_call_mercury, "
+:- pragma foreign_proc("C", test4(A::out, _B::in, C::out),
+ [promise_pure, will_not_call_mercury],
+"
MR_make_aligned_string_copy(A, """");
MR_make_aligned_string_copy(C, ""test4(out, in, out)"");
").
@@ -182,14 +205,20 @@
:- mode test5(in(ab), in(b), out) is det.
:- pragma promise_pure(test5/3).
-:- pragma c_code(test5(_A::in(a), _B::in(ab), C::out), will_not_call_mercury, "
+:- pragma foreign_proc("C",
+ test5(_A::in(a), _B::in(ab), C::out),
+ [promise_pure, will_not_call_mercury],
+"
MR_make_aligned_string_copy(C, ""test5(in(a), in(ab), out)"");
").
test5(_A::in(a), _B::in(ab), C::out) :-
C = "test5(in(a), in(ab), out)".
-:- pragma c_code(test5(_A::in(ab), _B::in(b), C::out), will_not_call_mercury, "
+:- pragma foreign_proc("C",
+ test5(_A::in(ab), _B::in(b), C::out),
+ [promise_pure, will_not_call_mercury],
+"
MR_make_aligned_string_copy(C, ""test5(in(ab), in(b), out)"");
").
test5(_A::in(ab), _B::in(b), C::out) :-
Index: tests/hard_coded/no_inline.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/no_inline.m,v
retrieving revision 1.7
diff -u -r1.7 no_inline.m
--- tests/hard_coded/no_inline.m 14 Aug 2009 03:21:54 -0000 1.7
+++ tests/hard_coded/no_inline.m 30 Aug 2010 13:52:49 -0000
@@ -25,7 +25,10 @@
:- pragma no_inline(bar/1).
:- impure pred bar(int::out) is det.
-:- pragma c_code(bar(Value::out), "
+:- pragma foreign_proc("C",
+ bar(Value::out),
+ [will_not_call_mercury],
+"
{
static int counter = 0;
Index: tests/hard_coded/nondet_c.exp
===================================================================
RCS file: tests/hard_coded/nondet_c.exp
diff -N tests/hard_coded/nondet_c.exp
--- tests/hard_coded/nondet_c.exp 26 Mar 1999 04:34:22 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,21 +0,0 @@
-/abcdef
-a/bcdef
-ab/cdef
-abc/def
-abcd/ef
-abcde/f
-abcdef/
-/abcdef
-a/bcdef
-ab/cdef
-abc/def
-abcd/ef
-abcde/f
-abcdef/
-/abcdef
-a/bcdef
-ab/cdef
-abc/def
-abcd/ef
-abcde/f
-abcdef/
Index: tests/hard_coded/nondet_c.m
===================================================================
RCS file: tests/hard_coded/nondet_c.m
diff -N tests/hard_coded/nondet_c.m
--- tests/hard_coded/nondet_c.m 29 Mar 2006 08:08:01 -0000 1.5
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,184 +0,0 @@
-% This test checks to see whether the compiler handles all three forms of
-% nondet C code OK.
-
-:- module nondet_c.
-
-:- interface.
-
-:- import_module io.
-
-:- pred main(io__state::di, io__state::uo) is det.
-
-:- implementation.
-
-:- import_module list, pair, solutions.
-
-main -->
- { solutions(split_pairs1("abcdef"), Pairs1) },
- print_pairs(Pairs1),
- { solutions(split_pairs2("abcdef"), Pairs2) },
- print_pairs(Pairs2),
- { solutions(split_pairs3("abcdef"), Pairs3) },
- print_pairs(Pairs3).
-
-:- pred print_pairs(list(pair(string))::in, io__state::di, io__state::uo)
- is det.
-
-print_pairs([]) --> [].
-print_pairs([Left - Right | Pairs]) -->
- io__write_string(Left),
- io__write_string("/"),
- io__write_string(Right),
- io__write_string("\n"),
- print_pairs(Pairs).
-
-:- pred split_pairs1(string::in, pair(string)::out) is multi.
-
-split_pairs1(Whole, Left - Right) :-
- break_string1(Left, Right, Whole).
-
-:- pred split_pairs2(string::in, pair(string)::out) is multi.
-
-split_pairs2(Whole, Left - Right) :-
- break_string2(Left, Right, Whole).
-
-:- pred split_pairs3(string::in, pair(string)::out) is multi.
-
-split_pairs3(Whole, Left - Right) :-
- break_string3(Left, Right, Whole).
-
-:- pred break_string1(string, string, string).
-:- mode break_string1(out, out, in) is multi.
-
-:- pragma c_header_code("
- #include <string.h>
- #include ""mercury_heap.h""
-").
-
-:- pragma c_code(break_string1(LeftHalf::out, RightHalf::out, WholeString::in),
-will_not_call_mercury,
-local_vars("
- /* here we declare any local variables that we need to save */
- MR_String s;
- size_t len;
- size_t count;
-"),
-first_code(/* This comment tests whether
-the context of the following code is computed correctly
-*/ "
- /* this code gets executed on a call, but not on a retry */
- LOCALS->s = WholeString;
- LOCALS->len = strlen(WholeString);
- LOCALS->count = 0;
-"),
-retry_code("
- /* this code gets executed on a retry */
- LOCALS->count++;
-"),
-shared_code("
- MR_Word temp;
-
- /* this code gets executed for both calls and retries */
- MR_offset_incr_hp_atomic(temp, 0,
- (LOCALS->count + sizeof(MR_Word)) / sizeof(MR_Word));
- LeftHalf = (MR_String) temp;
- memcpy(LeftHalf, LOCALS->s, LOCALS->count);
- LeftHalf[LOCALS->count] = '\\0';
- MR_offset_incr_hp_atomic(temp, 0,
- (LOCALS->len - LOCALS->count + sizeof(MR_Word))
- / sizeof(MR_Word));
- RightHalf = (MR_String) temp;
- strcpy(RightHalf, LOCALS->s + LOCALS->count);
-
- if (LOCALS->count < LOCALS->len) {
- SUCCEED;
- } else {
- SUCCEED_LAST;
- }
-")).
-
-:- pred break_string2(string, string, string).
-:- mode break_string2(out, out, in) is multi.
-
-:- pragma c_code(break_string2(LeftHalf::out, RightHalf::out, WholeString::in),
-will_not_call_mercury,
-local_vars("
- /* here we declare any local variables that we need to save */
- MR_String s;
- size_t len;
- size_t count;
-"),
-first_code("
- /* this code gets executed on a call, but not on a retry */
- LOCALS->s = WholeString;
- LOCALS->len = strlen(WholeString);
- LOCALS->count = 0;
-"),
-retry_code("
- /* this code gets executed on a retry */
- LOCALS->count++;
-"),
-duplicated_code("
- MR_Word temp;
-
- /* this code gets executed for both calls and retries */
- MR_offset_incr_hp_atomic(temp, 0,
- (LOCALS->count + sizeof(MR_Word)) / sizeof(MR_Word));
- LeftHalf = (MR_String) temp;
- memcpy(LeftHalf, LOCALS->s, LOCALS->count);
- LeftHalf[LOCALS->count] = '\\0';
- MR_offset_incr_hp_atomic(temp, 0,
- (LOCALS->len - LOCALS->count + sizeof(MR_Word))
- / sizeof(MR_Word));
- RightHalf = (MR_String) temp;
- strcpy(RightHalf, LOCALS->s + LOCALS->count);
-
- if (LOCALS->count < LOCALS->len) {
- SUCCEED;
- } else {
- SUCCEED_LAST;
- }
-")).
-
-:- pred break_string3(string, string, string).
-:- mode break_string3(out, out, in) is multi.
-
-:- pragma c_code(break_string3(LeftHalf::out, RightHalf::out, WholeString::in),
-will_not_call_mercury,
-local_vars("
- /* here we declare any local variables that we need to save */
- MR_String s;
- size_t len;
- size_t count;
-"),
-first_code("
- /* this code gets executed on a call, but not on a retry */
- LOCALS->s = WholeString;
- LOCALS->len = strlen(WholeString);
- LOCALS->count = 0;
-"),
-retry_code("
- /* this code gets executed on a retry */
- LOCALS->count++;
-"),
-common_code("
- MR_Word temp;
-
- /* this code gets executed for both calls and retries */
- MR_offset_incr_hp_atomic(temp, 0,
- (LOCALS->count + sizeof(MR_Word)) / sizeof(MR_Word));
- LeftHalf = (MR_String) temp;
- memcpy(LeftHalf, LOCALS->s, LOCALS->count);
- LeftHalf[LOCALS->count] = '\\0';
- MR_offset_incr_hp_atomic(temp, 0,
- (LOCALS->len - LOCALS->count + sizeof(MR_Word))
- / sizeof(MR_Word));
- RightHalf = (MR_String) temp;
- strcpy(RightHalf, LOCALS->s + LOCALS->count);
-
- if (LOCALS->count < LOCALS->len) {
- SUCCEED;
- } else {
- SUCCEED_LAST;
- }
-")).
Index: tests/hard_coded/nondet_pragma_c_bug.exp
===================================================================
RCS file: tests/hard_coded/nondet_pragma_c_bug.exp
diff -N tests/hard_coded/nondet_pragma_c_bug.exp
--- tests/hard_coded/nondet_pragma_c_bug.exp 30 May 2002 11:00:14 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,10 +0,0 @@
-foo:
-20
-10
-42
-99
-bar:
-20
-10
-42
-99
Index: tests/hard_coded/nondet_pragma_c_bug.m
===================================================================
RCS file: tests/hard_coded/nondet_pragma_c_bug.m
diff -N tests/hard_coded/nondet_pragma_c_bug.m
--- tests/hard_coded/nondet_pragma_c_bug.m 4 Apr 2006 02:39:21 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,67 +0,0 @@
-:- module nondet_pragma_c_bug.
-
-:- interface.
-
-:- import_module io.
-
-:- pred main(io__state::di, io__state::uo) is cc_multi.
-
-:- implementation.
-
-:- import_module solutions.
-
-main -->
- print("foo:\n"),
- unsorted_aggregate(foo, print_soln),
- print("bar:\n"),
- unsorted_aggregate(bar, print_soln).
-
-:- pred print_soln(int::in, io::di, io::uo) is det.
-print_soln(Soln) --> write(Soln), nl.
-
-:- pred foo(int).
-:- mode foo(out) is nondet.
-:- pragma c_code(foo(X::out), [may_call_mercury],
- local_vars("
- int state;
- "),
- first_code("
- LOCALS->state = 1;
- "),
- retry_code("
- LOCALS->state++;
- "),
- common_code("
- switch (LOCALS->state) {
- case 1: X = 20; SUCCEED; break;
- case 2: X = 10; SUCCEED; break;
- case 3: X = 42; SUCCEED; break;
- case 4: X = 99; SUCCEED; break;
- case 5: FAIL; break;
- }
- ")
-).
-
-:- pred bar(int).
-:- mode bar(out) is nondet.
-:- pragma c_code(bar(X::out), [may_call_mercury],
- local_vars("
- int state;
- "),
- first_code("
- LOCALS->state = 1;
- "),
- retry_code("
- LOCALS->state++;
- "),
- common_code("
- switch (LOCALS->state) {
- case 1: X = 20; SUCCEED; break;
- case 2: X = 10; SUCCEED; break;
- case 3: X = 42; SUCCEED; break;
- case 4: X = 99; SUCCEED; break;
- case 5: X = 123; FAIL; break;
- }
- ")
-).
-
Index: tests/hard_coded/pragma_export.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/pragma_export.m,v
retrieving revision 1.2
diff -u -r1.2 pragma_export.m
--- tests/hard_coded/pragma_export.m 26 Aug 2000 16:31:45 -0000 1.2
+++ tests/hard_coded/pragma_export.m 31 Aug 2010 04:01:35 -0000
@@ -1,4 +1,4 @@
-% This test case tests using `pragma export' on a procedure defined
+% This test case tests using `pragma foreign_export' on a procedure defined
% in a different module (in this case, one from the standard library).
% Previously the MLDS back-end was failing this test case.
@@ -15,7 +15,11 @@
:- pred my_write_string(string::in, io__state::di, io__state::uo) is det.
-:- pragma import(my_write_string(in, di, uo),
- [may_call_mercury, thread_safe], "write_str").
+:- pragma foreign_proc("C",
+ my_write_string(Str::in, _IO0::di, _IO::uo),
+ [promise_pure, may_call_mercury, thread_safe],
+"
+ write_str(Str);
+").
-:- pragma export(io__write_string(in, di, uo), "write_str").
+:- pragma foreign_export("C", io__write_string(in, di, uo), "write_str").
Index: tests/hard_coded/pragma_import.exp
===================================================================
RCS file: tests/hard_coded/pragma_import.exp
diff -N tests/hard_coded/pragma_import.exp
--- tests/hard_coded/pragma_import.exp 15 Feb 2007 00:41:53 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,12 +0,0 @@
-X = 101
-Y = 201.0
-S = Foo
-X1 = 1
-X2 = 102
-XX1 = 1
-XX2 = 102
-Y1 = 301
-Y2 = 302
-baz failed, as expected
-Z = 401
-quux failed, as expected
Index: tests/hard_coded/pragma_import.m
===================================================================
RCS file: tests/hard_coded/pragma_import.m
diff -N tests/hard_coded/pragma_import.m
--- tests/hard_coded/pragma_import.m 1 Apr 2004 04:51:21 -0000 1.5
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,88 +0,0 @@
-:- module pragma_import.
-:- interface.
-:- import_module io.
-
-:- pred main(io__state::di, io__state::uo) is det.
-
-:- implementation.
-
-main -->
- foo(100, X, 200.0, Y, "Foo", S),
- print("X = "), print(X), nl,
- print("Y = "), print(Y), nl,
- print("S = "), print(S), nl,
- { bar(X, X1) = X2 },
- print("X1 = "), print(X1), nl,
- print("X2 = "), print(X2), nl,
- { bar2(X, XX1) = XX2 },
- print("XX1 = "), print(XX1), nl,
- print("XX2 = "), print(XX2), nl,
- ( { baz(300, Y1) = Y2 } ->
- print("Y1 = "), print(Y1), nl,
- print("Y2 = "), print(Y2), nl
- ;
- print("baz failed unexpectedly"), nl
- ),
- ( { baz(-300, _) = _ } ->
- print("baz succeeded unexpectedly"), nl
- ;
- print("baz failed, as expected"), nl
- ),
- ( { quux(400, Z) } ->
- print("Z = "), print(Z), nl
- ;
- print("quux failed unexpectedly"), nl
- ),
- ( { quux(-400, _) } ->
- print("quux succeeded unexpectedly"), nl
- ;
- print("quux failed, as expected"), nl
- ).
-
-:- pred foo(int::in, int::out, float::in, float::out, string::in, string::out,
- io__state::di, io__state::uo) is det.
-:- func bar(int::in, int::out) = (int::out) is det.
-:- func bar2(int::in, int::out) = (int::out) is det.
-:- func baz(int::in, int::out) = (int::out) is semidet.
-:- pred quux(int::in, int::out) is semidet.
-
-:- pragma import(foo(in, out, in, out, in, out, di, uo), "cfoo").
-:- pragma import(bar(in, out) = out, will_not_call_mercury, "cbar").
-:- pragma export(bar(in, out) = out, "mbar").
-:- pragma import(bar2(in, out) = out, [may_call_mercury, thread_safe], "mbar").
-:- pragma import(baz(in, out) = out, "cbaz").
-:- pragma import(quux(in, out), may_call_mercury, "cquux").
-
-:- pragma c_header_code("
- typedef MR_Integer Int;
- void cfoo(Int, Int *, MR_Float, MR_Float *, MR_String, MR_String *);
- Int cbar(Int, Int *);
- MR_bool cbaz(Int, Int *, Int *);
- MR_bool cquux(Int, Int *);
-").
-
-:- pragma c_code("
-
-void cfoo(Int a1, Int *a2, MR_Float a3, MR_Float *a4, MR_String a5, MR_String *a6) {
- *a2 = a1 + 1;
- *a4 = a3 + 1.0;
- *a6 = a5;
-}
-
-Int cbar(Int a1, Int *a2) {
- *a2 = 1;
- return a1 + *a2;
-}
-
-MR_bool cbaz(Int a1, Int *a2, Int *a3) {
- *a2 = a1 + 1;
- *a3 = a1 + 2;
- return a1 + *a2 + *a3 > 0;
-}
-
-MR_bool cquux(Int a1, Int *a2) {
- *a2 = a1 + 1;
- return a1 + *a2 > 0;
-}
-
-").
Index: tests/hard_coded/redoip_clobber.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/redoip_clobber.m,v
retrieving revision 1.8
diff -u -r1.8 redoip_clobber.m
--- tests/hard_coded/redoip_clobber.m 7 May 2010 03:12:27 -0000 1.8
+++ tests/hard_coded/redoip_clobber.m 31 Aug 2010 03:59:22 -0000
@@ -39,8 +39,9 @@
:- pred use(int).
:- mode use(in) is semidet.
-:- pragma c_code(use(X::in),
- [will_not_call_mercury],
+:- pragma foreign_proc("C",
+ use(X::in),
+ [will_not_call_mercury, promise_pure],
"
/*
** To exhibit the bug, this predicate needs only to fail.
Index: tests/hard_coded/typeclasses/superclass_bug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/typeclasses/superclass_bug.m,v
retrieving revision 1.3
diff -u -r1.3 superclass_bug.m
--- tests/hard_coded/typeclasses/superclass_bug.m 28 Nov 2002 13:14:40 -0000 1.3
+++ tests/hard_coded/typeclasses/superclass_bug.m 31 Aug 2010 01:18:24 -0000
@@ -90,11 +90,11 @@
:- mode ixmldomnode_replacechild_c_code(in, out, in, out, out, in, out) = out
is det.
-:- pragma c_code(ixmldomnode_replacechild_c_code(IntroducedIdlBug_1InPtr::in,
+:- pragma foreign_proc("C", ixmldomnode_replacechild_c_code(IntroducedIdlBug_1InPtr::in,
IntroducedIdlBug_1OutPtr::out, IntroducedIdlBug_2InPtr::in,
IntroducedIdlBug_2OutPtr::out, OutOldChildPtr::out,
InTypeVarPtr::in, OutTypeVarPtr::out) = (HResult::out),
- [will_not_call_mercury, thread_safe],
+ [promise_pure, will_not_call_mercury, thread_safe],
"
OutOldChildPtr = (MR_Word) NULL;
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.240
diff -u -r1.240 Mmakefile
--- tests/invalid/Mmakefile 30 Mar 2010 23:57:27 -0000 1.240
+++ tests/invalid/Mmakefile 31 Aug 2010 01:44:34 -0000
@@ -123,7 +123,6 @@
instance_var_bug \
invalid_event \
invalid_export_detism \
- invalid_import_detism \
invalid_instance_declarations \
invalid_main \
invalid_mllibs \
Index: tests/invalid/foreign_decl_line_number.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/foreign_decl_line_number.m,v
retrieving revision 1.3
diff -u -r1.3 foreign_decl_line_number.m
--- tests/invalid/foreign_decl_line_number.m 5 Jan 2004 14:32:02 -0000 1.3
+++ tests/invalid/foreign_decl_line_number.m 31 Aug 2010 01:19:04 -0000
@@ -26,7 +26,7 @@
:- type my_foreign_type.
:- pragma foreign_type("C", my_foreign_type, "int").
-:- pragma export(bar(out,di,uo), "bar").
+:- pragma foreign_export("C", bar(out,di,uo), "bar").
:- pred bar(my_foreign_type::out, io::di,io::uo) is det.
bar(X) --> foo(X).
Index: tests/invalid/invalid_import_detism.err_exp
===================================================================
RCS file: tests/invalid/invalid_import_detism.err_exp
diff -N tests/invalid/invalid_import_detism.err_exp
--- tests/invalid/invalid_import_detism.err_exp 14 Sep 2005 05:26:47 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,4 +0,0 @@
-invalid_import_detism.m:010: Error: `pragma_import' declaration for a procedure
-invalid_import_detism.m:010: that has a determinism of nondet.
-invalid_import_detism.m:011: Error: `pragma_import' declaration for a procedure
-invalid_import_detism.m:011: that has a determinism of multi.
Index: tests/invalid/invalid_import_detism.m
===================================================================
RCS file: tests/invalid/invalid_import_detism.m
diff -N tests/invalid/invalid_import_detism.m
--- tests/invalid/invalid_import_detism.m 22 Mar 2005 01:19:39 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,11 +0,0 @@
-:- module invalid_import_detism.
-
-:- interface.
-
-:- pred foo(int::in, int::out) is nondet.
-:- pred bar(int::in, int::out) is multi.
-
-:- implementation.
-
-:- pragma import(foo(in, out), "IMPORTED_FOO").
-:- pragma import(bar(in, out), "IMPORTED_BAR").
Index: tests/invalid/method_impl.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/method_impl.m,v
retrieving revision 1.2
diff -u -r1.2 method_impl.m
--- tests/invalid/method_impl.m 12 Apr 2005 07:58:20 -0000 1.2
+++ tests/invalid/method_impl.m 31 Aug 2010 01:21:08 -0000
@@ -28,7 +28,7 @@
main -->
[].
-:- pragma c_header_code("int foo_counter = 0;").
+:- pragma foreign_code("C", "int foo_counter = 0;").
foo_m1(_, "forty two").
Index: tests/invalid/multimode_missing_impure.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/multimode_missing_impure.m,v
retrieving revision 1.2
diff -u -r1.2 multimode_missing_impure.m
--- tests/invalid/multimode_missing_impure.m 7 Nov 2002 16:17:08 -0000 1.2
+++ tests/invalid/multimode_missing_impure.m 31 Aug 2010 01:22:49 -0000
@@ -46,5 +46,5 @@
puts("test2(out, out)").
:- pred puts(string::in) is det.
-:- pragma c_code(puts(S::in), [will_not_call_mercury], "puts(S)").
+:- pragma foreign_proc("C", puts(S::in), [promise_pure, will_not_call_mercury], "puts(S);").
puts(_).
Index: tests/invalid/pragma_c_code_dup_var.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/pragma_c_code_dup_var.m,v
retrieving revision 1.1
diff -u -r1.1 pragma_c_code_dup_var.m
--- tests/invalid/pragma_c_code_dup_var.m 10 Dec 1999 02:18:10 -0000 1.1
+++ tests/invalid/pragma_c_code_dup_var.m 31 Aug 2010 01:24:02 -0000
@@ -1,5 +1,5 @@
% Test errors for variables occurring multiple times in
-% a `:- pragma c_code' argument list.
+% a `:- pragma foreign_proc' argument list.
:- module pragma_c_code_dup_var.
:- interface.
@@ -16,8 +16,10 @@
:- implementation.
-:- pragma c_code(bread_impl(MC_Object0::in, MC_Object::out, Buf::in, Buf::out, Nbyte::in, MC_IO0::di, MC_IO::uo) = (Mc_returnval::out),
- will_not_call_mercury, "
+:- pragma foreign_proc("C",
+ bread_impl(MC_Object0::in, MC_Object::out, Buf::in, Buf::out, Nbyte::in, MC_IO0::di, MC_IO::uo) = (Mc_returnval::out),
+ [promise_pure, will_not_call_mercury],
+"
Mc_returnval = apache_gen__apache__request__bread(MC_Object0, &MC_Object, Buf, &Buf, Nbyte);
MC_IO = MC_IO0;
").
Index: tests/valid/big_foreign_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/big_foreign_type.m,v
retrieving revision 1.4
diff -u -r1.4 big_foreign_type.m
--- tests/valid/big_foreign_type.m 14 Aug 2009 03:21:55 -0000 1.4
+++ tests/valid/big_foreign_type.m 31 Aug 2010 03:54:59 -0000
@@ -40,7 +40,7 @@
:- implementation.
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
struct Foo {
int x, y, z;
};
@@ -105,7 +105,7 @@
baz3(X) = X.
baz4(X) = X.
-:- pragma export(baz(in) = out, "baz").
-:- pragma export(baz2(in) = out, "baz2").
-:- pragma export(baz3(in) = out, "baz3").
-:- pragma export(baz4(in) = out, "baz4").
+:- pragma foreign_export("C", baz(in) = out, "baz").
+:- pragma foreign_export("C", baz2(in) = out, "baz2").
+:- pragma foreign_export("C", baz3(in) = out, "baz3").
+:- pragma foreign_export("C", baz4(in) = out, "baz4").
Index: tests/valid/export_before_func.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/export_before_func.m,v
retrieving revision 1.2
diff -u -r1.2 export_before_func.m
--- tests/valid/export_before_func.m 29 Mar 2006 08:08:09 -0000 1.2
+++ tests/valid/export_before_func.m 31 Aug 2010 03:55:18 -0000
@@ -10,7 +10,7 @@
foo.
-:- pragma export(return_yes(in) = out, "EXPORTED_return_yes").
+:- pragma foreign_export("C", return_yes(in) = out, "EXPORTED_return_yes").
:- func return_yes(string) = maybe(string).
return_yes(Str) = yes(Str).
Index: tests/valid/int64.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/int64.m,v
retrieving revision 1.2
diff -u -r1.2 int64.m
--- tests/valid/int64.m 7 Nov 2002 12:52:58 -0000 1.2
+++ tests/valid/int64.m 31 Aug 2010 01:09:03 -0000
@@ -15,7 +15,12 @@
:- type int64 == int.
-:- pragma c_code((A::in) /\ (B::in) = (C::out), [], "C = A & B;").
+:- pragma foreign_proc("C",
+ (A::in) /\ (B::in) = (C::out),
+ [promise_pure, will_not_call_mercury],
+"
+ C = A & B;
+").
% implementation for the other backends.
A /\ _B = A.
Index: tests/valid/intermod_pragma_import2.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/intermod_pragma_import2.m,v
retrieving revision 1.1
diff -u -r1.1 intermod_pragma_import2.m
--- tests/valid/intermod_pragma_import2.m 9 Feb 2001 03:27:36 -0000 1.1
+++ tests/valid/intermod_pragma_import2.m 31 Aug 2010 03:57:42 -0000
@@ -10,5 +10,11 @@
p(_, 4).
-:- pragma import(implemented_as_pragma_import(in, out), "imported").
-:- pragma export(p(in, out), "imported").
+:- pragma foreign_proc("C",
+ implemented_as_pragma_import(I::in, O::out),
+ [promise_pure, will_not_call_mercury],
+"
+ imported(TypeInfo_for_T, I, &O);
+").
+
+:- pragma foreign_export("C", p(in, out), "imported").
Index: tests/valid/liveness_nonlocals.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/liveness_nonlocals.m,v
retrieving revision 1.2
diff -u -r1.2 liveness_nonlocals.m
--- tests/valid/liveness_nonlocals.m 7 Nov 2002 12:52:58 -0000 1.2
+++ tests/valid/liveness_nonlocals.m 31 Aug 2010 01:12:01 -0000
@@ -41,8 +41,12 @@
:- pred foo_int(T, int).
:- mode foo_int(in, out(bound(0))) is det.
-:- pragma c_code(foo_int(_V2::in, Res::out(bound(0))),
- will_not_call_mercury, "Res = 0").
+:- pragma foreign_proc("C",
+ foo_int(_V2::in, Res::out(bound(0))),
+ [promise_pure, will_not_call_mercury],
+"
+ Res = 0;
+").
foo_int(_, 0).
:- pred int_to_bool(int, bool).
Index: tests/valid/subtype_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/subtype_switch.m,v
retrieving revision 1.7
diff -u -r1.7 subtype_switch.m
--- tests/valid/subtype_switch.m 10 Jul 2006 04:40:59 -0000 1.7
+++ tests/valid/subtype_switch.m 31 Aug 2010 01:12:43 -0000
@@ -59,11 +59,11 @@
stringify_config(_Interp, title(Text), Str, IO, IO) :-
string__format("-title ""%s""", [s(Text)], Str).
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
extern MR_Integer tk_direct_thingy_counter;
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
MR_Integer tk_direct_thingy_counter = 0;
").
Index: tests/valid/tabled_for_io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/tabled_for_io.m,v
retrieving revision 1.2
diff -u -r1.2 tabled_for_io.m
--- tests/valid/tabled_for_io.m 7 Nov 2002 12:52:59 -0000 1.2
+++ tests/valid/tabled_for_io.m 31 Aug 2010 01:13:21 -0000
@@ -11,8 +11,9 @@
:- implementation.
-:- pragma c_code(test(A::in, B::out, IO0::di, IO::uo),
- [will_not_call_mercury, tabled_for_io],
+:- pragma foreign_proc("C",
+ test(A::in, B::out, IO0::di, IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
"
B = A;
IO = IO0;
Index: tests/valid/undead_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/undead_proc.m,v
retrieving revision 1.2
diff -u -r1.2 undead_proc.m
--- tests/valid/undead_proc.m 12 Sep 2005 09:22:52 -0000 1.2
+++ tests/valid/undead_proc.m 31 Aug 2010 01:13:47 -0000
@@ -8,6 +8,6 @@
:- pred p(int::out) is det.
-:- pragma export(p(out), "p").
+:- pragma foreign_export("C", p(out), "p").
p(42).
Index: tests/valid/zero_arity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/zero_arity.m,v
retrieving revision 1.5
diff -u -r1.5 zero_arity.m
--- tests/valid/zero_arity.m 7 Nov 2002 12:52:59 -0000 1.5
+++ tests/valid/zero_arity.m 31 Aug 2010 01:14:37 -0000
@@ -37,7 +37,10 @@
quux :- semidet_fail.
-:- pragma c_code(use_asm_labels, [will_not_call_mercury, thread_safe], "
+:- pragma foreign_proc("C",
+ use_asm_labels,
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
#ifdef MR_USE_ASM_LABELS
SUCCESS_INDICATOR = MR_TRUE;
#else
Index: tests/warnings/purity_warnings.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/purity_warnings.m,v
retrieving revision 1.6
diff -u -r1.6 purity_warnings.m
--- tests/warnings/purity_warnings.m 23 Aug 2007 04:08:39 -0000 1.6
+++ tests/warnings/purity_warnings.m 31 Aug 2010 01:15:38 -0000
@@ -70,8 +70,8 @@
semipure_method_a_impl -->
semipure print("semipure_method_a_impl\n"). % warn
-:- pragma c_header_code("extern int x;").
-:- pragma c_code("int x = 0;").
+:- pragma foreign_decl("C", "extern int x;").
+:- pragma foreign_code("C", "int x = 0;").
:- pragma foreign_code("C#", "
static int x = 0;
").
Index: tests/warnings/singleton_test.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/singleton_test.exp,v
retrieving revision 1.15
diff -u -r1.15 singleton_test.exp
--- tests/warnings/singleton_test.exp 14 Aug 2009 20:37:57 -0000 1.15
+++ tests/warnings/singleton_test.exp 31 Aug 2010 03:52:52 -0000
@@ -14,8 +14,8 @@
singleton_test.m:027: warning: variable `T' occurs only once in this scope.
singleton_test.m:029: In the C code for predicate `singleton_test.my_c_pred'/3:
singleton_test.m:029: warning: variable `Y' does not occur in the C code.
-singleton_test.m:045: In the C code for function `singleton_test.my_c_func'/2:
-singleton_test.m:045: warning: variable `X' does not occur in the C code.
-singleton_test.m:063: In the C code for predicate
-singleton_test.m:063: `singleton_test.c_hello_world'/3:
-singleton_test.m:063: warning: variable `Msg' does not occur in the C code.
+singleton_test.m:046: In the C code for function `singleton_test.my_c_func'/2:
+singleton_test.m:046: warning: variable `X' does not occur in the C code.
+singleton_test.m:065: In the C code for predicate
+singleton_test.m:065: `singleton_test.c_hello_world'/3:
+singleton_test.m:065: warning: variable `Msg' does not occur in the C code.
Index: tests/warnings/singleton_test.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/singleton_test.m,v
retrieving revision 1.8
diff -u -r1.8 singleton_test.m
--- tests/warnings/singleton_test.m 23 Aug 2007 04:08:40 -0000 1.8
+++ tests/warnings/singleton_test.m 31 Aug 2010 01:17:24 -0000
@@ -26,7 +26,8 @@
my_append_func([], L) = L :- L1 = L2.
my_append_func([H | T], L) = [H | my_append_func(L, L)].
-:- pragma c_code(my_c_pred(X::in, Y::in, Z::out), will_not_call_mercury, "
+:- pragma foreign_proc("C", my_c_pred(X::in, Y::in, Z::out),
+ [promise_pure, will_not_call_mercury], "
Z = 2 * X;
").
:- pragma foreign_proc("C#", my_c_pred(X::in, Y::in, Z::out),
@@ -42,7 +43,8 @@
Z = 2 * X
").
-:- pragma c_code(my_c_func(X::in, Y::in) = (Z::out), will_not_call_mercury, "
+:- pragma foreign_proc("C", my_c_func(X::in, Y::in) = (Z::out),
+ [promise_pure, will_not_call_mercury], "
Z = 2 * Y;
").
:- pragma foreign_proc("C#", my_c_func(X::in, Y::in) = (Z::out),
@@ -58,10 +60,10 @@
Z = 2 * Y
").
-:- pragma c_header_code("#include <stdio.h>").
+:- pragma foreign_decl("C", "#include <stdio.h>").
-:- pragma c_code(c_hello_world(Msg::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+:- pragma foreign_proc("C", c_hello_world(Msg::in, IO0::di, IO::uo),
+ [promise_pure, will_not_call_mercury], "
printf(""Hello, world"");
IO = IO0;
").
--------------------------------------------------------------------------
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