[m-dev.] for review: add MC++ implementation of library and runtime
Tyson Dowd
trd at cs.mu.OZ.AU
Mon Dec 4 23:32:26 AEDT 2000
===================================================================
Estimated hours taken: 80
First implementation of the standard library in managed C++.
configure.in:
Autodetect the .NET SDK, and set MSNETSDKDIR based on it.
Find the IL assembler, and set ILASM.
library/*.m:
Add pragma foreign_code for MC++.
Rename pragma c_code as pragma foreign_code("C", ...).
Only a fraction of the predicates are implemented, everything
else simply throws and exception when called.
Implementations of predicates marked with :- external are
provided as pragma foreign_code, but are commented out.
library/Mmakefile:
runtime/Mmakefile:
Add targets for building the dlls for the library.
runtime/mercury_cpp.cpp:
Implementation of the runtime.
runtime/mercury_il.il:
This file mainly implements things that can't be written in
managed C++ (e.g. function pointers).
scripts/Mmake.rules:
scripts/Mmake.vars.in:
Add rules for generating .dlls and .exes from .ils and .cpps.
Index: configure.in
===================================================================
RCS file: /home/mercury1/repository/mercury/configure.in,v
retrieving revision 1.237
diff -u -r1.237 configure.in
--- configure.in 2000/12/01 03:22:14 1.237
+++ configure.in 2000/12/03 07:12:04
@@ -309,6 +309,26 @@
AC_SUBST(CYGPATH)
#-----------------------------------------------------------------------------#
+# Microsoft.NET configuration
+#
+AC_PATH_PROG(ILASM, ilasm)
+
+AC_MSG_CHECKING(for Microsoft.NET Framework SDK)
+AC_CACHE_VAL(mercury_cv_microsoft_dotnet, [
+if test "$ILASM" != ""; then
+ MSNETSDKDIR=`expr $ILASM : '\(.*\)/bin/ilasm'`
+ mercury_cv_microsoft_dotnet="yes"
+else
+ MSNETSDKDIR=""
+ mercury_cv_microsoft_dotnet="no"
+fi
+])
+AC_MSG_RESULT($mercury_cv_microsoft_dotnet)
+
+AC_SUBST(ILASM)
+AC_SUBST(MSNETSDKDIR)
+
+#-----------------------------------------------------------------------------#
# Don't try to use mprotect() on gnu-win32, since it is broken
# (at least for version b18, anyway) and trying it can crash Win95.
case "$host" in
Index: library/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/library/Mmakefile,v
retrieving revision 1.54
diff -u -r1.54 Mmakefile
--- library/Mmakefile 2000/11/12 05:26:11 1.54
+++ library/Mmakefile 2000/12/01 03:34:04
@@ -86,6 +86,8 @@
$(INTERMODULE_OPTS) $(CHECK_TERM_OPTS)
MGNUC = $(M_ENV) $(SCRIPTS_DIR)/mgnuc
MGNUCFLAGS = $(DLL_CFLAGS)
+MSCLFLAGS = -I$(RUNTIME_DIR)
+MSCL_NOASM=:noAssembly
LDFLAGS = -L$(BOEHM_GC_DIR) -L$(RUNTIME_DIR)
ALL_LDFLAGS = $(LDFLAGS) $(EXTRA_LDFLAGS)
LDLIBS = -l$(RT_LIB_NAME) \
@@ -192,13 +194,52 @@
#-----------------------------------------------------------------------------#
-.PHONY: os cs
+.PHONY: os cs ils
os: $(library.os)
cs: $(library.cs)
+ils: $(library.ils)
+library.dlls = $(library.mods:%=%.dll)
+dlls: $(library.dlls)
#-----------------------------------------------------------------------------#
.PHONY: lib_std
+
+ifeq ($(GRADE),ilc)
+
+lib_std: dlls mercury.dll
+
+LIBDLLS=$(library.dlls:%=%)
+RUNTIMEDLLS=../runtime/mercury_cpp.dll ../runtime/mercury_il.dll
+CPPDLLS= array__c_code.dll \
+ benchmarking__c_code.dll \
+ builtin__c_code.dll \
+ char__c_code.dll \
+ exception__c_code.dll \
+ float__c_code.dll \
+ gc__c_code.dll \
+ int__c_code.dll \
+ io__c_code.dll \
+ library__c_code.dll \
+ math__c_code.dll \
+ private_builtin__c_code.dll \
+ sparse_bitset__c_code.dll \
+ std_util__c_code.dll \
+ store__c_code.dll \
+ string__c_code.dll \
+ table_builtin__c_code.dll \
+ time__c_code.dll
+ALLDLLS=$(LIBDLLS) $(CPPDLLS) $(RUNTIMEDLLS)
+
+EMBEDALLDLLS=$(foreach file,$(ALLDLLS),/embed:$(file),$(patsubst %.dll,%,$(file)),Y)
+
+mercury.dll: $(ALLDLLS)
+ al -out:mercury.dll $(ALLDLLS)
+
+# al -v:1.0.0.0 -keyf:mercury.key -out:mercury.dll $(ALLDLLS)
+
+else
+
# the following dependency is just there to improve compilation speed;
# making tree234.$O first improves effective parallelism with parallel makes.
lib_std: $(os_subdir)tree234.$O
@@ -226,6 +267,8 @@
grep '^INIT ' $$file; \
echo "INIT mercury__`basename $$file .m`__init"; \
done > $(STD_LIB_NAME).init
+
+endif
#-----------------------------------------------------------------------------#
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.79
diff -u -r1.79 array.m
--- library/array.m 2000/12/03 02:22:44 1.79
+++ library/array.m 2000/12/03 07:12:48
@@ -323,7 +323,7 @@
%-----------------------------------------------------------------------------%
-:- pragma c_code("
+:- pragma foreign_code("C", "
#ifdef MR_HIGHLEVEL_CODE
void sys_init_array_module_builtins(void);
@@ -392,6 +392,45 @@
").
+:- pragma foreign_code("MC++", "
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(array, array, 1, MR_TYPECTOR_REP_ARRAY)
+
+ static int
+ mercury__array____Unify____array_1_0(MR_Word type_info,
+ MR_Word x, MR_Word y)
+ {
+ MR_Runtime::SORRY(""unify for array"");
+ return 0;
+ }
+
+ static void
+ mercury__array____Compare____array_1_0(
+ MR_Word type_info, MR_Word_Ref result, MR_Word x, MR_Word y)
+ {
+ MR_Runtime::SORRY(""compare for array"");
+ }
+
+ static int
+ mercury__array__do_unify__array_1_0(MR_Word type_info, MR_Box x, MR_Box y)
+ {
+ return mercury__array____Unify____array_1_0(
+ type_info,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+ }
+
+ static void
+ mercury__array__do_compare__array_1_0(
+ MR_Word type_info, MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ mercury__array____Compare____array_1_0(
+ type_info, result,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+ }
+").
+
+
%-----------------------------------------------------------------------------%
% unify/2 for arrays
@@ -448,16 +487,16 @@
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include ""mercury_library_types.h"" /* for MR_ArrayType */
#include ""mercury_misc.h"" /* for MR_fatal_error() */
").
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
MR_ArrayType *ML_make_array(MR_Integer size, MR_Word item);
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
MR_ArrayType *
ML_make_array(MR_Integer size, MR_Word item)
{
@@ -473,55 +512,114 @@
}
").
-:- pragma c_code(array__init(Size::in, Item::in, Array::array_uo),
+:- pragma foreign_code("C",
+ array__init(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation(Size + 1, MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_make_array(Size, Item);
").
-:- pragma c_code(array__make_empty_array(Array::array_uo),
+:- pragma foreign_code("C",
+ array__make_empty_array(Array::array_uo),
[will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation(1, MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_make_array(0, 0);
").
+:- pragma foreign_code("MC++",
+ array__init(Size::in, Item::in, Array::array_uo),
+ [will_not_call_mercury, thread_safe], "
+ // XXX still need to do init
+ Array = (MR_Word) Array::CreateInstance(Item->GetType(), Size);
+").
+
+:- pragma foreign_code("MC++",
+ array__make_empty_array(Array::array_uo),
+ [will_not_call_mercury, thread_safe], "
+ Array = (MR_Word)
+ Array::CreateInstance((new Object)->GetType(), 0);
+").
+
+
%-----------------------------------------------------------------------------%
-:- pragma c_code(array__min(Array::array_ui, Min::out),
+:- pragma foreign_code("C",
+ array__min(Array::array_ui, Min::out),
[will_not_call_mercury, thread_safe], "
/* Array not used */
Min = 0;
").
-:- pragma c_code(array__min(Array::in, Min::out),
+:- pragma foreign_code("C",
+ array__min(Array::in, Min::out),
[will_not_call_mercury, thread_safe], "
/* Array not used */
Min = 0;
").
-:- pragma c_code(array__max(Array::array_ui, Max::out),
+:- pragma foreign_code("MC++",
+ array__min(Array::array_ui, Min::out),
+ [will_not_call_mercury, thread_safe], "
+ /* Array not used */
+ Min = 0;
+").
+:- pragma foreign_code("MC++",
+ array__min(Array::in, Min::out),
[will_not_call_mercury, thread_safe], "
+ /* Array not used */
+ Min = 0;
+").
+
+:- pragma foreign_code("C",
+ array__max(Array::array_ui, Max::out),
+ [will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size - 1;
").
-:- pragma c_code(array__max(Array::in, Max::out),
+:- pragma foreign_code("C",
+ array__max(Array::in, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size - 1;
").
+:- pragma foreign_code("MC++",
+ array__max(Array::array_ui, Max::out),
+ [will_not_call_mercury, thread_safe], "
+ Max = Array->get_Length() - 1;
+").
+:- pragma foreign_code("MC++",
+ array__max(Array::in, Max::out),
+ [will_not_call_mercury, thread_safe], "
+ Max = Array->get_Length() - 1;
+").
+
array__bounds(Array, Min, Max) :-
array__min(Array, Min),
array__max(Array, Max).
%-----------------------------------------------------------------------------%
-:- pragma c_code(array__size(Array::array_ui, Max::out),
+:- pragma foreign_code("C",
+ array__size(Array::array_ui, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size;
").
-:- pragma c_code(array__size(Array::in, Max::out),
+:- pragma foreign_code("C",
+ array__size(Array::in, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size;
").
+:- pragma foreign_code("MC++",
+ array__size(Array::array_ui, Max::out),
+ [will_not_call_mercury, thread_safe], "
+ Max = Array->get_Length() - 1;
+").
+:- pragma foreign_code("MC++",
+ array__size(Array::in, Max::out),
+ [will_not_call_mercury, thread_safe], "
+ Max = Array->get_Length() - 1;
+").
+
+
%-----------------------------------------------------------------------------%
array__in_bounds(Array, Index) :-
@@ -546,7 +644,8 @@
%-----------------------------------------------------------------------------%
-:- pragma c_code(array__lookup(Array::array_ui, Index::in, Item::out),
+:- pragma foreign_code("C",
+ array__lookup(Array::array_ui, Index::in, Item::out),
[will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array;
#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
@@ -556,7 +655,8 @@
#endif
Item = array->elements[Index];
}").
-:- pragma c_code(array__lookup(Array::in, Index::in, Item::out),
+:- pragma foreign_code("C",
+ array__lookup(Array::in, Index::in, Item::out),
[will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array;
#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
@@ -567,9 +667,22 @@
Item = array->elements[Index];
}").
+:- pragma foreign_code("MC++",
+ array__lookup(Array::array_ui, Index::in, Item::out),
+ [will_not_call_mercury, thread_safe], "{
+ Item = Array->GetValue(Index);
+}").
+:- pragma foreign_code("MC++",
+ array__lookup(Array::in, Index::in, Item::out),
+ [will_not_call_mercury, thread_safe], "{
+ Item = Array->GetValue(Index);
+}").
+
+
%-----------------------------------------------------------------------------%
-:- pragma c_code(array__set(Array0::array_di, Index::in,
+:- pragma foreign_code("C",
+ array__set(Array0::array_di, Index::in,
Item::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array0;
@@ -582,14 +695,23 @@
Array = Array0;
}").
+:- pragma foreign_code("MC++",
+ array__set(Array0::array_di, Index::in,
+ Item::in, Array::array_uo),
+ [will_not_call_mercury, thread_safe], "{
+ Array0->SetValue(Item, Index); /* destructive update! */
+ Array = Array0;
+}").
+
+
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
MR_ArrayType * ML_resize_array(MR_ArrayType *old_array,
MR_Integer array_size, MR_Word item);
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
MR_ArrayType *
ML_resize_array(MR_ArrayType *old_array, MR_Integer array_size,
MR_Word item)
@@ -623,21 +745,28 @@
}
").
-:- pragma c_code(array__resize(Array0::array_di, Size::in, Item::in,
+:- pragma foreign_code("C",
+ array__resize(Array0::array_di, Size::in, Item::in,
Array::array_uo), [will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation(Size + 1, MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_resize_array(
(MR_ArrayType *) Array0, Size, Item);
").
+:- pragma foreign_code("MC++",
+ array__resize(_Array0::array_di, _Size::in, _Item::in,
+ _Array::array_uo), [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
MR_ArrayType * ML_shrink_array(MR_ArrayType *old_array,
MR_Integer array_size);
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
MR_ArrayType *
ML_shrink_array(MR_ArrayType *old_array, MR_Integer array_size)
{
@@ -668,20 +797,27 @@
}
").
-:- pragma c_code(array__shrink(Array0::array_di, Size::in, Array::array_uo),
+:- pragma foreign_code("C",
+ array__shrink(Array0::array_di, Size::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation(Size + 1, MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_shrink_array(
(MR_ArrayType *) Array0, Size);
").
+:- pragma foreign_code("MC++",
+ array__shrink(_Array0::array_di, _Size::in, _Array::array_uo),
+ [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
MR_ArrayType *ML_copy_array(MR_ArrayType *old_array);
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
MR_ArrayType *
ML_copy_array(MR_ArrayType *old_array)
{
@@ -704,18 +840,35 @@
}
").
-:- pragma c_code(array__copy(Array0::array_ui, Array::array_uo),
+:- pragma foreign_code("C",
+ array__copy(Array0::array_ui, Array::array_uo),
[will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation((((MR_ArrayType *) Array0)->size) + 1,
MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_copy_array((MR_ArrayType *) Array0);
").
-:- pragma c_code(array__copy(Array0::in, Array::array_uo),
+:- pragma foreign_code("C",
+ array__copy(Array0::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
MR_maybe_record_allocation((((MR_ArrayType *) Array0)->size) + 1,
MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_copy_array((MR_ArrayType *) Array0);
+").
+
+:- pragma foreign_code("MC++",
+ array__copy(Array0::array_ui, Array::array_uo),
+ [will_not_call_mercury, thread_safe], "
+ // XXX need to deep copy it
+ Array = Array0;
+
+").
+
+:- pragma foreign_code("MC++",
+ array__copy(Array0::in, Array::array_uo),
+ [will_not_call_mercury, thread_safe], "
+ // XXX need to deep copy it
+ Array = Array0;
").
%-----------------------------------------------------------------------------%
Index: library/benchmarking.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/benchmarking.m,v
retrieving revision 1.37
diff -u -r1.37 benchmarking.m
--- library/benchmarking.m 2000/11/28 05:51:58 1.37
+++ library/benchmarking.m 2000/12/03 07:12:48
@@ -57,7 +57,7 @@
:- implementation.
:- import_module int, std_util.
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include ""mercury_timing.h""
#include ""mercury_heap.h""
@@ -66,23 +66,33 @@
extern void ML_report_full_memory_stats(void);
-"). % end pragma c_header_code
+"). % end pragma foreign_decl
-:- pragma c_code(report_stats, will_not_call_mercury,
+:- pragma foreign_code("C", report_stats, will_not_call_mercury,
"
ML_report_stats();
").
-:- pragma c_code(report_full_memory_stats, will_not_call_mercury,
+:- pragma foreign_code("C", report_full_memory_stats, will_not_call_mercury,
"
#ifdef PROFILE_MEMORY
ML_report_full_memory_stats();
#endif
").
+:- pragma foreign_code("MC++", report_stats, will_not_call_mercury,
+"
+ // Do nothing
+").
+
+:- pragma foreign_code("MC++", report_full_memory_stats, will_not_call_mercury,
+"
+ // Do nothing
+").
+
%-----------------------------------------------------------------------------%
-:- pragma c_code("
+:- pragma foreign_code("C", "
#include <stdio.h>
#include <stdlib.h>
@@ -605,25 +615,44 @@
( true ; impure repeat(N - 1) ).
:- impure pred get_user_cpu_miliseconds(int::out) is det.
-:- pragma c_code(get_user_cpu_miliseconds(Time::out), [will_not_call_mercury],
+:- pragma foreign_code("C",
+ get_user_cpu_miliseconds(Time::out), [will_not_call_mercury],
"
Time = MR_get_user_cpu_miliseconds();
").
+:- pragma foreign_code("MC++",
+ get_user_cpu_miliseconds(Time::out), [will_not_call_mercury],
+"
+ // This won't return the elapsed time since program start,
+ // as it begins timing after the first call.
+ // For computing time differences it should be fine.
+ // XXX this is documented but not here. Perhaps it is fixed
+ // in .NET Frameworks Beta1?
+ // Time = (int) (1000 * Diagnostics::Counter::GetElapsed());
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
/*
** To prevent the C compiler from optimizing the benchmark code
** away, we assign the benchmark output to a volatile global variable.
*/
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
extern volatile MR_Word ML_benchmarking_dummy_word;
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
volatile MR_Word ML_benchmarking_dummy_word;
").
:- impure pred do_nothing(T::in) is det.
-:- pragma c_code(do_nothing(X::in), [will_not_call_mercury, thread_safe], "
+:- pragma foreign_code("C",
+ do_nothing(X::in), [will_not_call_mercury, thread_safe], "
+ ML_benchmarking_dummy_word = (MR_Word) X;
+").
+:- pragma foreign_code("MC++",
+ do_nothing(X::in), [will_not_call_mercury, thread_safe],
+"
+ volatile MR_Word ML_benchmarking_dummy_word;
ML_benchmarking_dummy_word = (MR_Word) X;
").
@@ -636,10 +665,18 @@
% Create a new int_reference given a term for it to reference.
:- impure pred new_int_reference(int::in, int_reference::out) is det.
:- pragma inline(new_int_reference/2).
-:- pragma c_code(new_int_reference(X::in, Ref::out), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ new_int_reference(X::in, Ref::out), will_not_call_mercury,
+"
MR_incr_hp(Ref, 1);
* (MR_Integer *) Ref = X;
").
+:- pragma foreign_code("MC++",
+ new_int_reference(_X::in, _Ref::out), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
:- impure pred incr_ref(int_reference::in) is det.
incr_ref(Ref) :-
@@ -648,14 +685,24 @@
:- semipure pred ref_value(int_reference::in, int::out) is det.
:- pragma inline(ref_value/2).
-:- pragma c_code(ref_value(Ref::in, X::out), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ ref_value(Ref::in, X::out), will_not_call_mercury, "
X = * (MR_Integer *) Ref;
").
+:- pragma foreign_code("MC++",
+ ref_value(_Ref::in, _X::out), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
:- impure pred update_ref(int_reference::in, T::in) is det.
:- pragma inline(update_ref/2).
-:- pragma c_code(update_ref(Ref::in, X::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ update_ref(Ref::in, X::in), will_not_call_mercury, "
* (MR_Integer *) Ref = X;
+").
+:- pragma foreign_code("MC++",
+ update_ref(_Ref::in, _X::in), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
").
%-----------------------------------------------------------------------------%
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.47
diff -u -r1.47 builtin.m
--- library/builtin.m 2000/12/03 02:22:45 1.47
+++ library/builtin.m 2000/12/03 07:23:15
@@ -229,14 +229,22 @@
:- mode cc_cast(pred(out) is cc_nondet) = out(pred(out) is semidet) is det.
:- mode cc_cast(pred(out) is cc_multi) = out(pred(out) is det) is det.
-:- pragma c_code(cc_cast(X :: (pred(out) is cc_multi)) =
+:- pragma foreign_code("C", cc_cast(X :: (pred(out) is cc_multi)) =
(Y :: out(pred(out) is det)),
[will_not_call_mercury, thread_safe],
"Y = X;").
-:- pragma c_code(cc_cast(X :: (pred(out) is cc_nondet)) =
+:- pragma foreign_code("C", cc_cast(X :: (pred(out) is cc_nondet)) =
(Y :: out(pred(out) is semidet)),
[will_not_call_mercury, thread_safe],
"Y = X;").
+:- pragma foreign_code("MC++", cc_cast(X :: (pred(out) is cc_multi)) =
+ (Y :: out(pred(out) is det)),
+ [will_not_call_mercury, thread_safe],
+ "Y = X;").
+:- pragma foreign_code("MC++", cc_cast(X :: (pred(out) is cc_nondet)) =
+ (Y :: out(pred(out) is semidet)),
+ [will_not_call_mercury, thread_safe],
+ "Y = X;").
promise_only_solution_io(Pred, X) -->
call(cc_cast_io(Pred), X).
@@ -245,8 +253,14 @@
:- mode cc_cast_io(pred(out, di, uo) is cc_multi) =
out(pred(out, di, uo) is det) is det.
-:- pragma c_code(cc_cast_io(X :: (pred(out, di, uo) is cc_multi)) =
- (Y :: out(pred(out, di, uo) is det)),
+:- pragma foreign_code("C",
+ cc_cast_io(X :: (pred(out, di, uo) is cc_multi)) =
+ (Y :: out(pred(out, di, uo) is det)),
+ [will_not_call_mercury, thread_safe],
+ "Y = X;").
+:- pragma foreign_code("MC++",
+ cc_cast_io(X :: (pred(out, di, uo) is cc_multi)) =
+ (Y :: out(pred(out, di, uo) is det)),
[will_not_call_mercury, thread_safe],
"Y = X;").
@@ -262,9 +276,9 @@
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("#include ""mercury_type_info.h""").
+:- pragma foreign_decl("C", "#include ""mercury_type_info.h""").
-:- pragma c_code("
+:- pragma foreign_code("C", "
#ifdef MR_HIGHLEVEL_CODE
void sys_init_builtin_types_module(void); /* suppress gcc warning */
@@ -391,6 +405,483 @@
}
#endif /* ! HIGHLEVEL_CODE */
+
+").
+
+/*
+
+XXX :- external stops us from using this
+
+:- pragma foreign_code("MC++", compare(Res::uo, X::in, Y::in),
+ [may_call_mercury], "
+
+ MR_TypeInfo type_info;
+ MR_TypeCtorInfo type_ctor_info;
+ int arity;
+ MR_TypeInfoParams params;
+ MR_Word *args;
+
+ type_info = (MR_TypeInfo) TypeInfo_for_T;
+ type_ctor_info = dynamic_cast<MR_Word> (type_info->GetValue(0));
+
+ if (type_ctor_info == 0) {
+ type_ctor_info = type_info;
+ }
+
+ if (0) {
+ // code for higher order...
+ } else {
+ arity = mr_convert::ToInt32(type_ctor_info->GetValue(0));
+ // params = ???
+ }
+
+ switch(arity) {
+ case 0:
+ generic::generic_res_call3(
+ type_ctor_info->GetValue(3),
+ &Res, X, Y);
+ break;
+ case 1:
+ generic::generic_res_call4(
+ type_ctor_info->GetValue(3),
+ type_info->GetValue(1),
+ &Res, X, Y);
+ break;
+ case 2:
+ generic::generic_res_call5(
+ type_ctor_info->GetValue(3),
+ type_info->GetValue(1),
+ type_info->GetValue(2),
+ &Res, X, Y);
+ break;
+ case 3:
+ generic::generic_res_call6(
+ type_ctor_info->GetValue(3),
+ type_info->GetValue(1),
+ type_info->GetValue(2),
+ type_info->GetValue(3),
+ &Res, X, Y);
+ break;
+ case 4:
+ generic::generic_res_call7(
+ type_ctor_info->GetValue(3),
+ type_info->GetValue(1),
+ type_info->GetValue(2),
+ type_info->GetValue(3),
+ type_info->GetValue(4),
+ &Res, X, Y);
+ break;
+ case 5:
+ generic::generic_res_call8(
+ type_ctor_info->GetValue(3),
+ type_info->GetValue(1),
+ type_info->GetValue(2),
+ type_info->GetValue(3),
+ type_info->GetValue(4),
+ type_info->GetValue(5),
+ &Res, X, Y);
+ break;
+ default:
+ MR_Runtime::MR_fatal_error(
+ ""compare/3: type arity > 5 not supported"");
+ }
+").
+
+:- pragma foreign_code("MC++", compare(Res::uo, X::ui, Y::ui),
+ [may_call_mercury], "
+ compare_3_p_0(TypeInfo_for_T, &Res, X, Y);
+").
+
+:- pragma foreign_code("MC++", compare(Res::uo, X::ui, Y::in),
+ [may_call_mercury], "
+ compare_3_p_0(TypeInfo_for_T, &Res, X, Y);
+").
+
+:- pragma foreign_code("MC++", compare(Res::uo, X::in, Y::ui),
+ [may_call_mercury], "
+ compare_3_p_0(TypeInfo_for_T, &Res, X, Y);
+").
+
+:- pragma foreign_code("MC++", copy(_X::ui, _Y::uo),
+ [may_call_mercury], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++", copy(_X::in, _Y::uo),
+ [may_call_mercury], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++", unify(X::in, Y::in),
+ [may_call_mercury], "
+{
+ MR_TypeInfo type_info;
+ MR_TypeCtorInfo type_ctor_info;
+ MR_Box tmp;
+ int arity;
+ MR_TypeInfoParams params;
+
+ type_info = (MR_TypeInfo) TypeInfo_for_T;
+
+ type_ctor_info = dynamic_cast<MR_Word> (type_info->GetValue(0));
+ if (type_ctor_info == 0) {
+ type_ctor_info = type_info;
+ }
+
+ // XXX insert code to handle higher order....
+ if (0) {
+
+ } else {
+ arity = mr_convert::ToInt32(type_ctor_info->GetValue(0));
+ // params = ???
+ }
+
+ // args = params;
+
+ switch(arity) {
+ case 0:
+ SUCCESS_INDICATOR = generic::generic_call2(
+ type_ctor_info->GetValue(1),
+ X, Y);
+ break;
+ case 1:
+ SUCCESS_INDICATOR = generic::generic_call3(
+ type_ctor_info->GetValue(1),
+ type_info->GetValue(1),
+ X, Y);
+ break;
+ case 2:
+ SUCCESS_INDICATOR = generic::generic_call4(
+ type_ctor_info->GetValue(1),
+ type_info->GetValue(1),
+ type_info->GetValue(2),
+ X, Y);
+ break;
+ case 3:
+ SUCCESS_INDICATOR = generic::generic_call5(
+ type_ctor_info->GetValue(1),
+ type_info->GetValue(1),
+ type_info->GetValue(2),
+ type_info->GetValue(3),
+ X, Y);
+ break;
+ case 4:
+ SUCCESS_INDICATOR = generic::generic_call6(
+ type_ctor_info->GetValue(1),
+ type_info->GetValue(1),
+ type_info->GetValue(2),
+ type_info->GetValue(3),
+ type_info->GetValue(4),
+ X, Y);
+ break;
+ case 5:
+ SUCCESS_INDICATOR = generic::generic_call7(
+ type_ctor_info->GetValue(1),
+ type_info->GetValue(1),
+ type_info->GetValue(2),
+ type_info->GetValue(3),
+ type_info->GetValue(4),
+ type_info->GetValue(5),
+ X, Y);
+ break;
+ default:
+ MR_Runtime::MR_fatal_error(
+ ""unify/2: type arity > 5 not supported"");
+ }
+}
+
+").
+
+*/
+
+:- pragma foreign_code("MC++", "
+
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(builtin, int, 0, MR_TYPECTOR_REP_INT)
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(builtin, character, 0,
+ MR_TYPECTOR_REP_CHAR)
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(builtin, string, 0,
+ MR_TYPECTOR_REP_STRING)
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(builtin, c_pointer, 0,
+ MR_TYPECTOR_REP_C_POINTER)
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(builtin, void, 0,
+ MR_TYPECTOR_REP_VOID)
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(builtin, float, 0,
+ MR_TYPECTOR_REP_FLOAT)
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(builtin, func, 0,
+ MR_TYPECTOR_REP_PRED)
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(builtin, pred, 0,
+ MR_TYPECTOR_REP_PRED)
+
+ static int
+ mercury__builtin____Unify____int_0_0(MR_Integer x, MR_Integer y)
+ {
+ return x == y;
+ }
+
+ static int
+ mercury__builtin____Unify____string_0_0(MR_String x, MR_String y)
+ {
+ return String::Equals(x, y);
+ }
+
+ static int
+ mercury__builtin____Unify____character_0_0(MR_Char x, MR_Char y)
+ {
+ return x == y;
+ }
+
+ static int
+ mercury__builtin____Unify____float_0_0(MR_Float x, MR_Float y)
+ {
+ return x == y;
+ }
+
+ static int
+ mercury__builtin____Unify____void_0_0(MR_Word x, MR_Word y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called unify for type `void'"");
+ return 0;
+ }
+
+ static int
+ mercury__builtin____Unify____c_pointer_0_0(MR_Word x, MR_Word y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called unify for type `c_pointer'"");
+ return 0;
+ }
+
+ static int
+ mercury__builtin____Unify____func_0_0(MR_Word x, MR_Word y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called unify for `func' type"");
+ return 0;
+ }
+
+ static int
+ mercury__builtin____Unify____pred_0_0(MR_Word x, MR_Word y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called unify for `pred' type"");
+ return 0;
+ }
+
+ static void
+ mercury__builtin____Compare____int_0_0(
+ MR_Word_Ref result, MR_Integer x, MR_Integer y)
+ {
+ MR_COMPARE_LESS);
+ MR_newobj(*result, r, 0);
+ }
+
+ static void
+ mercury__builtin____Compare____float_0_0(
+ MR_Word_Ref result, MR_Float x, MR_Float y)
+ {
+ (MR_Runtime::MR_fatal_error(
+ ""incomparable floats in compare/3""),
+ MR_COMPARE_EQUAL));
+ MR_newobj(*result, r, 0);
+ }
+
+
+ static void
+ mercury__builtin____Compare____string_0_0(MR_Word_Ref result,
+ MR_String x, MR_String y)
+ {
+ int res = String::Compare(x, y);
+ MR_COMPARE_LESS);
+ MR_newobj(*result, r, 0);
+ }
+
+ static void
+ mercury__builtin____Compare____character_0_0(
+ MR_Word_Ref result, MR_Char x, MR_Char y)
+ {
+ MR_COMPARE_LESS);
+ MR_newobj(*result, r, 0);
+ }
+
+ static void
+ mercury__builtin____Compare____void_0_0(MR_Word_Ref result,
+ MR_Word x, MR_Word y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called compare/3 for type `void'"");
+ }
+
+ static void
+ mercury__builtin____Compare____c_pointer_0_0(
+ MR_Word_Ref result, MR_Word x, MR_Word y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called compare/3 for type `c_pointer'"");
+ }
+
+ static void
+ mercury__builtin____Compare____func_0_0(MR_Word_Ref result,
+ MR_Word x, MR_Word y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called compare/3 for `func' type"");
+ }
+
+ static void
+ mercury__builtin____Compare____pred_0_0(MR_Word_Ref result,
+ MR_Word x, MR_Word y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called compare/3 for `pred' type"");
+ }
+
+/*
+** Unification procedures with the arguments boxed.
+** These are just wrappers which call the unboxed version.
+*/
+
+ static int
+ mercury__builtin__do_unify__int_0_0(MR_Box x, MR_Box y)
+ {
+ return mercury__builtin____Unify____int_0_0(
+ mr_convert::ToInt32(x),
+ mr_convert::ToInt32(y));
+ }
+
+ static int
+ mercury__builtin__do_unify__string_0_0(MR_Box x, MR_Box y)
+ {
+ return mercury__builtin____Unify____string_0_0(
+ dynamic_cast<MR_String>(x),
+ dynamic_cast<MR_String>(y));
+ }
+
+ static int
+ mercury__builtin__do_unify__float_0_0(MR_Box x, MR_Box y)
+ {
+ return mercury__builtin____Unify____float_0_0(
+ mr_convert::ToDouble(x), mr_convert::ToDouble(y));
+ }
+
+ static int
+ mercury__builtin__do_unify__character_0_0(MR_Box x, MR_Box y)
+ {
+ return mercury__builtin____Unify____character_0_0(
+ mr_convert::ToChar(x),
+ mr_convert::ToChar(y));
+ }
+
+ static int
+ mercury__builtin__do_unify__void_0_0(MR_Box x, MR_Box y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called unify for type `void'"");
+ return 0;
+ }
+
+ static int
+ mercury__builtin__do_unify__c_pointer_0_0(MR_Box x, MR_Box y)
+ {
+ return mercury__builtin____Unify____c_pointer_0_0(
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+ }
+
+ static int
+ mercury__builtin__do_unify__func_0_0(MR_Box x, MR_Box y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called unify for `func' type"");
+ return 0;
+ }
+
+ static int
+ mercury__builtin__do_unify__pred_0_0(MR_Box x, MR_Box y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called unify for `pred' type"");
+ return 0;
+ }
+
+/*
+** Comparison procedures with the arguments boxed.
+** These are just wrappers which call the unboxed version.
+*/
+
+ static void
+ mercury__builtin__do_compare__int_0_0(MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ mercury__builtin____Compare____int_0_0(result,
+ mr_convert::ToInt32(x),
+ mr_convert::ToInt32(y));
+ }
+
+ static void
+ mercury__builtin__do_compare__string_0_0(MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ mercury__builtin____Compare____string_0_0(result,
+ dynamic_cast<MR_String>(x),
+ dynamic_cast<MR_String>(y));
+ }
+
+ static void
+ mercury__builtin__do_compare__float_0_0(MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ mercury__builtin____Compare____float_0_0(result,
+ mr_convert::ToDouble(x), mr_convert::ToDouble(y));
+ }
+
+ static void
+ mercury__builtin__do_compare__character_0_0(
+ MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ mercury__builtin____Compare____character_0_0(
+ result,
+ mr_convert::ToChar(x),
+ mr_convert::ToChar(y));
+ }
+
+ static void
+ mercury__builtin__do_compare__void_0_0(MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called compare/3 for type `void'"");
+ }
+
+ static void
+ mercury__builtin__do_compare__c_pointer_0_0(
+ MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ mercury__builtin____Compare____c_pointer_0_0(
+ result,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+ }
+ static void
+ mercury__builtin__do_compare__func_0_0(MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called compare/3 for func type"");
+ }
+
+ static void
+ mercury__builtin__do_compare__pred_0_0(MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ MR_Runtime::MR_fatal_error(
+ ""called compare/3 for pred type"");
+ }
").
Index: library/char.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/char.m,v
retrieving revision 1.31
diff -u -r1.31 char.m
--- library/char.m 2000/11/12 08:51:33 1.31
+++ library/char.m 2000/12/01 03:34:04
@@ -413,17 +413,20 @@
%-----------------------------------------------------------------------------%
-:- pragma c_code(char__to_int(Character::in, Int::out),
+:- pragma foreign_code("C",
+ char__to_int(Character::in, Int::out),
[will_not_call_mercury, thread_safe] , "
Int = (MR_UnsignedChar) Character;
").
-:- pragma c_code(char__to_int(Character::in, Int::in),
+:- pragma foreign_code("C",
+ char__to_int(Character::in, Int::in),
[will_not_call_mercury, thread_safe] , "
SUCCESS_INDICATOR = ((MR_UnsignedChar) Character == Int);
").
-:- pragma c_code(char__to_int(Character::out, Int::in),
+:- pragma foreign_code("C",
+ char__to_int(Character::out, Int::in),
[will_not_call_mercury, thread_safe] , "
/*
** If the integer doesn't fit into a char, then
@@ -435,16 +438,44 @@
SUCCESS_INDICATOR = ((MR_UnsignedChar) Character == Int);
").
+:- pragma foreign_code("MC++",
+ char__to_int(Character::in, Int::out),
+ [will_not_call_mercury, thread_safe] , "
+ Int = Character;
+").
+
+:- pragma foreign_code("MC++",
+ char__to_int(Character::in, Int::in),
+ [will_not_call_mercury, thread_safe] , "
+ SUCCESS_INDICATOR = (Character == Int);
+").
+
+:- pragma foreign_code("MC++",
+ char__to_int(Character::out, Int::in),
+ [will_not_call_mercury, thread_safe] , "
+ Character = Int;
+ SUCCESS_INDICATOR = (Character == Int);
+").
+
% We used unsigned character codes, so the minimum character code
% is always zero.
char__min_char_value(0).
:- pragma c_header_code("#include <limits.h>").
-:- pragma c_code(char__max_char_value(Max::out),
- [will_not_call_mercury, thread_safe], "
+:- pragma foreign_code("C",
+ char__max_char_value(Max::out),
+ [will_not_call_mercury, thread_safe], "
Max = UCHAR_MAX;
").
+
+:- pragma foreign_code("MC++",
+ char__max_char_value(_Max::out),
+ [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""c code for this function"");
+").
+
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.36
diff -u -r1.36 exception.m
--- library/exception.m 2000/12/03 02:22:46 1.36
+++ library/exception.m 2000/12/03 07:12:49
@@ -207,7 +207,7 @@
% the C interface, since Mercury doesn't allow different code for different
% modes.
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
/* The `#ifndef ... #define ... #endif' guards against multiple inclusion */
#ifndef ML_DETERMINISM_GUARD
#define ML_DETERMINISM_GUARD
@@ -229,57 +229,140 @@
#endif
").
-:- pragma c_code(
+:- pragma foreign_code("C",
get_determinism(_Pred::pred(out) is det,
Det::out(bound(det))),
will_not_call_mercury,
"Det = ML_DET"
).
-:- pragma c_code(
+:- pragma foreign_code("C",
get_determinism(_Pred::pred(out) is semidet,
Det::out(bound(semidet))),
will_not_call_mercury,
"Det = ML_SEMIDET"
).
-:- pragma c_code(
+:- pragma foreign_code("C",
get_determinism(_Pred::pred(out) is cc_multi,
Det::out(bound(cc_multi))),
will_not_call_mercury,
"Det = ML_CC_MULTI"
).
-:- pragma c_code(
+:- pragma foreign_code("C",
get_determinism(_Pred::pred(out) is cc_nondet,
Det::out(bound(cc_nondet))),
will_not_call_mercury,
"Det = ML_CC_NONDET"
).
-:- pragma c_code(
+:- pragma foreign_code("C",
get_determinism(_Pred::pred(out) is multi,
Det::out(bound(multi))),
will_not_call_mercury,
"Det = ML_MULTI"
).
-:- pragma c_code(
+:- pragma foreign_code("C",
get_determinism(_Pred::pred(out) is nondet,
Det::out(bound(nondet))),
will_not_call_mercury,
"Det = ML_NONDET"
).
-:- pragma c_code(
+:- pragma foreign_code("C",
get_determinism_2(_Pred::pred(out, di, uo) is det,
Det::out(bound(det))),
will_not_call_mercury,
"Det = ML_DET"
).
-:- pragma c_code(
+:- pragma foreign_code("C",
get_determinism_2(_Pred::pred(out, di, uo) is cc_multi,
Det::out(bound(cc_multi))),
will_not_call_mercury,
"Det = ML_CC_MULTI"
).
+:- pragma foreign_decl("MC++", "
+/* The `#ifndef ... #define ... #endif' guards against multiple inclusion */
+#ifndef ML_DETERMINISM_GUARD
+#define ML_DETERMINISM_GUARD
+ #define zML_DET = 0
+ #define zML_SEMIDET = 1
+ #define zML_CC_MULTI = 2
+ #define zML_CC_NONDET = 3
+ #define zML_MULTI = 4
+ #define zML_NONDET = 5
+ #define zML_ERRONEOUS = 6
+ #define zML_FAILURE = 7
+
+ /*
+ ** The enumeration constants in this enum must be in the same
+ ** order as the functors in the Mercury type `determinism'
+ ** defined above.
+ */
+ typedef enum {
+ ML_DET,
+ ML_SEMIDET,
+ ML_CC_MULTI,
+ ML_CC_NONDET,
+ ML_MULTI,
+ ML_NONDET,
+ ML_ERRONEOUS,
+ ML_FAILURE
+ } ML_Determinism;
+#endif
+").
+
+:- pragma foreign_code("MC++",
+ get_determinism(_Pred::pred(out) is det,
+ Det::out(bound(det))),
+ will_not_call_mercury,
+ "MR_newobj(Det, ML_DET, 0);"
+).
+:- pragma foreign_code("MC++",
+ get_determinism(_Pred::pred(out) is semidet,
+ Det::out(bound(semidet))),
+ will_not_call_mercury,
+ "MR_newobj(Det, ML_SEMIDET, 0);"
+).
+:- pragma foreign_code("MC++",
+ get_determinism(_Pred::pred(out) is cc_multi,
+ Det::out(bound(cc_multi))),
+ will_not_call_mercury,
+ "MR_newobj(Det, ML_CC_MULTI, 0);"
+).
+:- pragma foreign_code("MC++",
+ get_determinism(_Pred::pred(out) is cc_nondet,
+ Det::out(bound(cc_nondet))),
+ will_not_call_mercury,
+ "MR_newobj(Det, ML_CC_NONDET, 0);"
+).
+:- pragma foreign_code("MC++",
+ get_determinism(_Pred::pred(out) is multi,
+ Det::out(bound(multi))),
+ will_not_call_mercury,
+ "MR_newobj(Det, ML_MULTI, 0);"
+).
+:- pragma foreign_code("MC++",
+ get_determinism(_Pred::pred(out) is nondet,
+ Det::out(bound(nondet))),
+ will_not_call_mercury,
+ "MR_newobj(Det, ML_NONDET, 0);"
+).
+
+:- pragma foreign_code("MC++",
+ get_determinism_2(_Pred::pred(out, di, uo) is det,
+ Det::out(bound(det))),
+ will_not_call_mercury,
+ "MR_newobj(Det, ML_DET, 0);"
+).
+
+:- pragma foreign_code("MC++",
+ get_determinism_2(_Pred::pred(out, di, uo) is cc_multi,
+ Det::out(bound(cc_multi))),
+ will_not_call_mercury,
+ "MR_newobj(Det, ML_CC_MULTI, 0);"
+).
+
+
% These are not worth inlining, since they will
% (presumably) not be called frequently, and so
% any increase in speed from inlining is not worth
@@ -432,11 +515,15 @@
impure consume_io_state(IOState).
:- impure pred make_io_state(io__state::uo) is det.
-:- pragma c_code(make_io_state(_IO::uo),
+:- pragma foreign_code("C", make_io_state(_IO::uo),
+ [will_not_call_mercury, thread_safe], "").
+:- pragma foreign_code("MC++", make_io_state(_IO::uo),
[will_not_call_mercury, thread_safe], "").
:- impure pred consume_io_state(io__state::di) is det.
-:- pragma c_code(consume_io_state(_IO::di),
+:- pragma foreign_code("C", consume_io_state(_IO::di),
+ [will_not_call_mercury, thread_safe], "").
+:- pragma foreign_code("MC++", consume_io_state(_IO::di),
[will_not_call_mercury, thread_safe], "").
:- pred wrap_exception(univ::in, exception_result(T)::out) is det.
@@ -808,6 +895,68 @@
#endif /* MR_HIGHLEVEL_CODE */
").
+
+/*
+
+XXX :- external stops us from using this
+
+:- pragma foreign_code("MC++", builtin_throw(_T::in), [will_not_call_mercury], "
+ mercury_exception *ex;
+
+ // XXX should look for string objects and set them as the message
+
+ if (false) {
+ ex = new mercury_exception;
+ } else {
+ ex = new mercury_exception(""hello"");
+ }
+
+ throw ex;
+").
+
+:- pragma foreign_code("MC++",
+ builtin_catch(_Pred::pred(out) is det,
+ _Handler::in(handler), _T::out), [will_not_call_mercury], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+:- pragma foreign_code("MC++",
+ builtin_catch(_Pred::pred(out) is semidet,
+ _Handler::in(handler), _T::out), [will_not_call_mercury], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+:- pragma foreign_code("MC++",
+ builtin_catch(_Pred::pred(out) is cc_multi,
+ _Handler::in(handler), _T::out), [will_not_call_mercury], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+:- pragma foreign_code("MC++",
+ builtin_catch(_Pred::pred(out) is cc_nondet,
+ _Handler::in(handler), _T::out), [will_not_call_mercury], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+:- pragma foreign_code("MC++",
+ builtin_catch(_Pred::pred(out) is multi,
+ _Handler::in(handler), _T::out), [will_not_call_mercury],
+ local_vars(""),
+ first_code(""),
+ retry_code(""),
+ common_code("
+ MR_Runtime::SORRY(""foreign code for this function"");
+ ")
+).
+:- pragma foreign_code("MC++",
+ builtin_catch(_Pred::pred(out) is nondet,
+ _Handler::in(handler), _T::out), [will_not_call_mercury],
+ local_vars(""),
+ first_code(""),
+ retry_code(""),
+ common_code("
+ MR_Runtime::SORRY(""foreign code for this function"");
+ ")
+).
+
+*/
+
/*********
This causes problems because the LLDS back-end
Index: library/float.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/float.m,v
retrieving revision 1.32
diff -u -r1.32 float.m
--- library/float.m 2000/11/28 05:51:59 1.32
+++ library/float.m 2000/12/03 07:12:49
@@ -354,7 +354,7 @@
% Header files of mathematical significance.
%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include <float.h>
#include <math.h>
@@ -376,37 +376,57 @@
% float__ceiling_to_int(X) returns the
% smallest integer not less than X.
-:- pragma c_code(float__ceiling_to_int(X :: in) = (Ceil :: out),
+:- pragma foreign_code("C", float__ceiling_to_int(X :: in) = (Ceil :: out),
[will_not_call_mercury, thread_safe],
"
Ceil = (MR_Integer) ceil(X);
").
+:- pragma foreign_code("MC++", float__ceiling_to_int(X :: in) = (Ceil :: out),
+ [will_not_call_mercury, thread_safe],
+"
+ Ceil = (MR_Integer) Math::Ceil(X);
+").
float__ceiling_to_int(X, float__ceiling_to_int(X)).
% float__floor_to_int(X) returns the
% largest integer not greater than X.
-:- pragma c_code(float__floor_to_int(X :: in) = (Floor :: out),
+:- pragma foreign_code("C", float__floor_to_int(X :: in) = (Floor :: out),
[will_not_call_mercury, thread_safe],
"
Floor = (MR_Integer) floor(X);
").
+:- pragma foreign_code("MC++", float__floor_to_int(X :: in) = (Floor :: out),
+ [will_not_call_mercury, thread_safe],
+"
+ Floor = (MR_Integer) Math::Floor(X);
+").
float__floor_to_int(X, float__floor_to_int(X)).
% float__round_to_int(X) returns the integer closest to X.
% If X has a fractional value of 0.5, it is rounded up.
-:- pragma c_code(float__round_to_int(X :: in) = (Round :: out),
+:- pragma foreign_code("C", float__round_to_int(X :: in) = (Round :: out),
[will_not_call_mercury, thread_safe],
"
Round = (MR_Integer) floor(X + 0.5);
").
+:- pragma foreign_code("MC++", float__round_to_int(X :: in) = (Round :: out),
+ [will_not_call_mercury, thread_safe],
+"
+ Round = (MR_Integer) Math::Floor(X + 0.5);
+").
float__round_to_int(X, float__round_to_int(X)).
% float__truncate_to_int(X) returns the integer closest
% to X such that |float__truncate_to_int(X)| =< |X|.
-:- pragma c_code(float__truncate_to_int(X :: in) = (Trunc :: out),
+:- pragma foreign_code("C", float__truncate_to_int(X :: in) = (Trunc :: out),
+ [will_not_call_mercury, thread_safe],
+"
+ Trunc = (MR_Integer) X;
+").
+:- pragma foreign_code("MC++", float__truncate_to_int(X :: in) = (Trunc :: out),
[will_not_call_mercury, thread_safe],
"
Trunc = (MR_Integer) X;
@@ -469,11 +489,16 @@
float__pow(X, Exp, float__pow(X, Exp)).
-:- pragma c_code(float__hash(F::in) = (H::out),
+:- pragma foreign_code("C", float__hash(F::in) = (H::out),
[will_not_call_mercury, thread_safe],
"
H = MR_hash_float(F);
").
+:- pragma foreign_code("MC++", float__hash(F::in) = (H::out),
+ [will_not_call_mercury, thread_safe],
+"
+ H = F.GetHashCode();
+").
float__hash(F, float__hash(F)).
@@ -507,55 +532,83 @@
").
% Maximum floating-point number
-:- pragma c_code(float__max = (Max::out),
+:- pragma foreign_code("C", float__max = (Max::out),
[will_not_call_mercury, thread_safe],
"Max = ML_FLOAT_MAX;").
+:- pragma foreign_code("MC++", float__max = (Max::out),
+ [will_not_call_mercury, thread_safe],
+ "Max = Double::MaxValue;").
+
float__max(float__max).
% Minimum normalised floating-point number */
-:- pragma c_code(float__min = (Min::out),
+:- pragma foreign_code("C", float__min = (Min::out),
[will_not_call_mercury, thread_safe],
"Min = ML_FLOAT_MIN;").
+:- pragma foreign_code("MC++", float__min = (Min::out),
+ [will_not_call_mercury, thread_safe],
+ "Min = Double::MinValue;").
float__min(float__min).
% Smallest x such that x \= 1.0 + x
-:- pragma c_code(float__epsilon = (Eps::out),
+:- pragma foreign_code("C", float__epsilon = (Eps::out),
[will_not_call_mercury, thread_safe],
"Eps = ML_FLOAT_EPSILON;").
+:- pragma foreign_code("MC++", float__epsilon = (Eps::out),
+ [will_not_call_mercury, thread_safe],
+ "Eps = Double::Epsilon;").
float__epsilon(float__epsilon).
% Radix of the floating-point representation.
-:- pragma c_code(float__radix = (Radix::out),
+:- pragma foreign_code("C", float__radix = (Radix::out),
[will_not_call_mercury, thread_safe],
"Radix = ML_FLOAT_RADIX;").
+:- pragma foreign_code("MC++", float__radix = (_Radix::out),
+ [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
float__radix(float__radix).
% The number of base-radix digits in the mantissa.
-:- pragma c_code(float__mantissa_digits = (MantDig::out),
+:- pragma foreign_code("C", float__mantissa_digits = (MantDig::out),
[will_not_call_mercury, thread_safe],
"MantDig = ML_FLOAT_MANT_DIG;").
+:- pragma foreign_code("MC++", float__mantissa_digits = (_MantDig::out),
+ [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
float__mantissa_digits(float__mantissa_digits).
% Minimum negative integer such that:
% radix ** (min_exponent - 1)
% is a normalised floating-point number.
-:- pragma c_code(float__min_exponent = (MinExp::out),
+:- pragma foreign_code("C", float__min_exponent = (MinExp::out),
[will_not_call_mercury, thread_safe],
"MinExp = ML_FLOAT_MIN_EXP;").
+:- pragma foreign_code("MC++", float__min_exponent = (_MinExp::out),
+ [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
float__min_exponent(float__min_exponent).
% Maximum integer such that:
% radix ** (max_exponent - 1)
% is a normalised floating-point number.
-:- pragma c_code(float__max_exponent = (MaxExp::out),
+:- pragma foreign_code("C", float__max_exponent = (MaxExp::out),
[will_not_call_mercury, thread_safe],
"MaxExp = ML_FLOAT_MAX_EXP;").
+
+:- pragma foreign_code("MC++", float__max_exponent = (_MaxExp::out),
+ [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
float__max_exponent(float__max_exponent).
Index: library/gc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/gc.m,v
retrieving revision 1.2
diff -u -r1.2 gc.m
--- library/gc.m 1999/12/21 10:33:57 1.2
+++ library/gc.m 2000/12/01 03:34:04
@@ -38,7 +38,7 @@
:- pragma no_inline(garbage_collect/0).
-:- pragma c_code(garbage_collect, [will_not_call_mercury], "
+:- pragma foreign_code("C", garbage_collect, [will_not_call_mercury], "
#ifdef CONSERVATIVE_GC
#ifndef MR_HIGHLEVEL_CODE
/* clear out the stacks and registers before garbage collecting */
@@ -49,6 +49,9 @@
GC_gcollect();
#endif
+").
+:- pragma foreign_code("MC++", garbage_collect, [will_not_call_mercury], "
+ // Do nothing
").
%---------------------------------------------------------------------------%
Index: library/int.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/int.m,v
retrieving revision 1.71
diff -u -r1.71 int.m
--- library/int.m 2000/11/12 23:02:35 1.71
+++ library/int.m 2000/12/01 03:34:04
@@ -453,22 +453,27 @@
:- pred int__to_float(int, float) is det.
:- mode int__to_float(in, out) is det.
*/
-:- pragma c_code(int__to_float(IntVal::in, FloatVal::out),
+:- pragma foreign_code("C", int__to_float(IntVal::in, FloatVal::out),
will_not_call_mercury,
"
FloatVal = IntVal;
").
+:- pragma foreign_code("MC++", int__to_float(IntVal::in, FloatVal::out),
+ will_not_call_mercury,
+"
+ FloatVal = (MR_Float) IntVal;
+").
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include <limits.h>
#define ML_BITS_PER_INT (sizeof(MR_Integer) * CHAR_BIT)
").
-:- pragma c_code(int__max_int(Max::out),
+:- pragma foreign_code("C", int__max_int(Max::out),
[will_not_call_mercury, thread_safe], "
if (sizeof(MR_Integer) == sizeof(int))
Max = INT_MAX;
@@ -478,7 +483,7 @@
MR_fatal_error(""Unable to figure out max integer size"");
").
-:- pragma c_code(int__min_int(Min::out),
+:- pragma foreign_code("C", int__min_int(Min::out),
[will_not_call_mercury, thread_safe], "
if (sizeof(MR_Integer) == sizeof(int))
Min = INT_MIN;
@@ -488,20 +493,47 @@
MR_fatal_error(""Unable to figure out min integer size"");
").
-:- pragma c_code(int__bits_per_int(Bits::out),
+:- pragma foreign_code("C", int__bits_per_int(Bits::out),
[will_not_call_mercury, thread_safe], "
Bits = ML_BITS_PER_INT;
").
-:- pragma c_code(int__quot_bits_per_int(Int::in) = (Div::out),
+:- pragma foreign_code("C", int__quot_bits_per_int(Int::in) = (Div::out),
[will_not_call_mercury, thread_safe], "
Div = Int / ML_BITS_PER_INT;
").
-:- pragma c_code(int__times_bits_per_int(Int::in) = (Result::out),
+:- pragma foreign_code("C", int__times_bits_per_int(Int::in) = (Result::out),
[will_not_call_mercury, thread_safe], "
Result = Int * ML_BITS_PER_INT;
").
+
+
+:- pragma foreign_code("MC++", int__max_int(Max::out),
+ [will_not_call_mercury, thread_safe], "
+ Max = Int32::MaxValue;
+").
+
+:- pragma foreign_code("MC++", int__min_int(Min::out),
+ [will_not_call_mercury, thread_safe], "
+ Min = Int32::MinValue;
+").
+
+:- pragma foreign_code("MC++", int__bits_per_int(Bits::out),
+ [will_not_call_mercury, thread_safe], "
+ Bits = 32;
+").
+
+:- pragma foreign_code("MC++", int__quot_bits_per_int(Int::in) = (Div::out),
+ [will_not_call_mercury, thread_safe], "
+ Div = Int / 32;
+").
+
+:- pragma foreign_code("MC++", int__times_bits_per_int(Int::in) = (Result::out),
+ [will_not_call_mercury, thread_safe], "
+ Result = Int * 32;
+").
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.214
diff -u -r1.214 io.m
--- library/io.m 2000/11/28 05:50:41 1.214
+++ library/io.m 2000/12/03 07:12:50
@@ -265,9 +265,9 @@
% If the argument is of type univ, then it will print out
% the value stored in the univ, but not the type.
% For higher-order types, or for types defined using the
-% foreign language interface (pragma c_code), the text output
-% will only describe the type that is being printed, not the
-% value.
+% foreign language interface (pragma foreign_code), the text
+% output will only describe the type that is being printed, not
+% the value.
:- pred io__write(T, io__state, io__state).
:- mode io__write(in, di, uo) is det.
@@ -282,14 +282,14 @@
% Strings and characters are always printed out in quotes,
% using backslash escapes if necessary.
% For higher-order types, or for types defined using the
-% foreign language interface (pragma c_code), the text output
-% will only describe the type that is being printed, not the
-% value, and the result may not be parsable by `io__read'.
-% For the types `univ' and `typeinfo', the result may not
-% be parsable by `io__read', either. But in all other cases
-% the format used is standard Mercury syntax, and if you do
-% append a period and newline (".\n"), then the results can
-% be read in again using `io__read'.
+% foreign language interface (pragma foreign_code), the text
+% output will only describe the type that is being printed, not
+% the value, and the result may not be parsable by `io__read'.
+% For the types `univ' and `typeinfo', the result may not be
+% parsable by `io__read', either. But in all other cases the
+% format used is standard Mercury syntax, and if you do append a
+% period and newline (".\n"), then the results can be read in
+% again using `io__read'.
:- pred io__nl(io__state, io__state).
:- mode io__nl(di, uo) is det.
@@ -1114,7 +1114,7 @@
% is so that `type_name' produces more informative results
% for cases such as `type_name(main)'.
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
extern MR_Word ML_io_stream_names;
extern MR_Word ML_io_user_globals;
#if 0
@@ -1122,7 +1122,7 @@
#endif
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
MR_Word ML_io_stream_names;
MR_Word ML_io_user_globals;
#if 0
@@ -1130,6 +1130,13 @@
#endif
").
+:- pragma foreign_code("MC++", "
+ static MR_Word ML_io_stream_names;
+ static MR_Word ML_io_user_globals;
+ static int next_id;
+").
+
+
:- type io__stream_names == map(io__stream_id, string).
:- type io__stream_putback == map(io__stream_id, list(char)).
@@ -1364,7 +1371,7 @@
io__state, io__state).
:- mode io__read_line_as_string_2(in, out, out, di, uo) is det.
-:- pragma c_code(io__read_line_as_string_2(File::in, Res :: out,
+:- pragma foreign_code("C", io__read_line_as_string_2(File::in, Res :: out,
RetString::out, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe],
"
@@ -1422,6 +1429,14 @@
update_io(IO0, IO);
").
+:- pragma foreign_code("MC++",
+ io__read_line_as_string_2(_File::in, _Res :: out, _RetString::out,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+ update_io(IO0, IO);
+").
+
io__read_file(Result) -->
io__input_stream(Stream),
io__read_file(Stream, Result).
@@ -1511,7 +1526,7 @@
:- mode io__clear_err(in, di, uo) is det.
% same as ANSI C's clearerr().
-:- pragma c_code(io__clear_err(Stream::in, _IO0::di, _IO::uo),
+:- pragma foreign_code("C", io__clear_err(Stream::in, _IO0::di, _IO::uo),
[will_not_call_mercury, thread_safe],
"{
MercuryFile *f = (MercuryFile *) Stream;
@@ -1523,6 +1538,13 @@
}
}").
+:- pragma foreign_code("MC++", io__clear_err(_Stream::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+
:- pred io__check_err(stream, io__res, io__state, io__state).
:- mode io__check_err(in, out, di, uo) is det.
@@ -1538,7 +1560,7 @@
:- mode io__ferror(in, out, out, di, uo) is det.
% similar to ANSI C's ferror().
-:- pragma c_code(ferror(Stream::in, RetVal::out, RetStr::out,
+:- pragma foreign_code("C", ferror(Stream::in, RetVal::out, RetStr::out,
_IO0::di, _IO::uo),
[will_not_call_mercury, thread_safe],
"{
@@ -1554,6 +1576,14 @@
MR_PROC_LABEL, RetStr);
}").
+:- pragma foreign_code("MC++", ferror(_Stream::in, _RetVal::out, _RetStr::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+
% io__make_err_msg(MessagePrefix, Message):
% `Message' is an error message obtained by looking up the
% message for the current value of errno and prepending
@@ -1561,12 +1591,21 @@
:- pred io__make_err_msg(string, string, io__state, io__state).
:- mode io__make_err_msg(in, out, di, uo) is det.
-:- pragma c_code(make_err_msg(Msg0::in, Msg::out, _IO0::di, _IO::uo),
+:- pragma foreign_code("C",
+ make_err_msg(Msg0::in, Msg::out, _IO0::di, _IO::uo),
will_not_call_mercury,
"{
ML_maybe_make_err_msg(TRUE, Msg0, MR_PROC_LABEL, Msg);
}").
+:- pragma foreign_code("MC++",
+ make_err_msg(_Msg0::in, _Msg::out, _IO0::di, _IO::uo),
+ will_not_call_mercury,
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+
%-----------------------------------------------------------------------------%
:- pred io__stream_file_size(stream, int, io__state, io__state).
@@ -1575,7 +1614,7 @@
% if Stream is a regular file, then Size is its size (in bytes),
% otherwise Size is -1.
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
@@ -1584,7 +1623,7 @@
#endif
").
-:- pragma c_code(io__stream_file_size(Stream::in, Size::out,
+:- pragma foreign_code("C", io__stream_file_size(Stream::in, Size::out,
_IO0::di, _IO::uo),
[will_not_call_mercury, thread_safe],
"{
@@ -1609,6 +1648,14 @@
#endif
}").
+:- pragma foreign_code("MC++", io__stream_file_size(_Stream::in, _Size::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+
%-----------------------------------------------------------------------------%
% A `buffer' is just an array of Chars.
@@ -1617,7 +1664,8 @@
:- type buffer ---> buffer(c_pointer).
:- pred io__alloc_buffer(int::in, buffer::uo) is det.
-:- pragma c_code(io__alloc_buffer(Size::in, Buffer::uo),
+:- pragma foreign_code("C",
+ io__alloc_buffer(Size::in, Buffer::uo),
[will_not_call_mercury, thread_safe],
"{
MR_incr_hp_atomic_msg(Buffer,
@@ -1627,8 +1675,9 @@
}").
:- pred io__resize_buffer(buffer::di, int::in, int::in, buffer::uo) is det.
-:- pragma c_code(io__resize_buffer(Buffer0::di, OldSize::in, NewSize::in,
- Buffer::uo),
+:- pragma foreign_code("C",
+ io__resize_buffer(Buffer0::di, OldSize::in,
+ NewSize::in, Buffer::uo),
[will_not_call_mercury, thread_safe],
"{
MR_Char *buffer0 = (MR_Char *) Buffer0;
@@ -1665,25 +1714,29 @@
}").
:- pred io__buffer_to_string(buffer::di, int::in, string::uo) is det.
-:- pragma c_code(io__buffer_to_string(Buffer::di, Len::in, Str::uo),
- [will_not_call_mercury, thread_safe],
+:- pragma foreign_code("C",
+ io__buffer_to_string(Buffer::di, Len::in, Str::uo),
+ [will_not_call_mercury, thread_safe],
"{
Str = (MR_String) Buffer;
Str[Len] = '\\0';
}").
+
:- pred io__buffer_to_string(buffer::di, string::uo) is det.
-:- pragma c_code(io__buffer_to_string(Buffer::di, Str::uo),
- [will_not_call_mercury, thread_safe],
+:- pragma foreign_code("C",
+ io__buffer_to_string(Buffer::di, Str::uo),
+ [will_not_call_mercury, thread_safe],
"{
Str = (MR_String) Buffer;
}").
+
:- pred io__read_into_buffer(stream::in, buffer::di, int::in, int::in,
buffer::uo, int::out, io__state::di, io__state::uo) is det.
-:- pragma c_code(io__read_into_buffer(Stream::in,
- Buffer0::di, Pos0::in, Size::in,
+:- pragma foreign_code("C",
+ io__read_into_buffer(Stream::in, Buffer0::di, Pos0::in, Size::in,
Buffer::uo, Pos::out, _IO0::di, _IO::uo),
[will_not_call_mercury, thread_safe],
"{
@@ -1697,6 +1750,44 @@
Pos = Pos0 + items_read;
}").
+:- pragma foreign_code("MC++",
+ io__alloc_buffer(_Size::in, _Buffer::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+:- pragma foreign_code("MC++",
+ io__resize_buffer(_Buffer0::di, _OldSize::in,
+ _NewSize::in, _Buffer::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+:- pragma foreign_code("MC++",
+ io__buffer_to_string(_Buffer::di, _Len::in, _Str::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+:- pragma foreign_code("MC++",
+ io__buffer_to_string(_Buffer::di, _Str::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+:- pragma foreign_code("MC++",
+ io__read_into_buffer(_Stream::in, _Buffer0::di, _Pos0::in, _Size::in,
+ _Buffer::uo, _Pos::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+
%-----------------------------------------------------------------------------%
io__read_binary_file(Result) -->
@@ -2243,11 +2334,18 @@
io__write_type_desc(TypeInfo).
:- func unsafe_cast(T1::in) = (T2::out) is det.
-:- pragma c_code(unsafe_cast(VarIn::in) = (VarOut::out),
- [will_not_call_mercury, thread_safe],
+:- pragma foreign_code("C",
+ unsafe_cast(VarIn::in) = (VarOut::out),
+ [will_not_call_mercury, thread_safe],
"
VarOut = VarIn;
").
+:- pragma foreign_code("MC++",
+ unsafe_cast(VarIn::in) = (VarOut::out),
+ [will_not_call_mercury, thread_safe],
+"
+ VarOut = VarIn;
+").
%-----------------------------------------------------------------------------%
@@ -2485,18 +2583,34 @@
:- pred io__get_stream_names(io__stream_names, io__state, io__state).
:- mode io__get_stream_names(out, di, uo) is det.
+
+:- pred io__set_stream_names(io__stream_names, io__state, io__state).
+:- mode io__set_stream_names(in, di, uo) is det.
-:- pragma c_code(io__get_stream_names(StreamNames::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__get_stream_names(StreamNames::out, IO0::di, IO::uo),
will_not_call_mercury, "
StreamNames = ML_io_stream_names;
update_io(IO0, IO);
").
-:- pred io__set_stream_names(io__stream_names, io__state, io__state).
-:- mode io__set_stream_names(in, di, uo) is det.
+:- pragma foreign_code("C",
+ io__set_stream_names(StreamNames::in, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ ML_io_stream_names = StreamNames;
+ update_io(IO0, IO);
+").
-:- pragma c_code(io__set_stream_names(StreamNames::in, IO0::di, IO::uo),
+:- pragma foreign_code("MC++",
+ io__get_stream_names(StreamNames::out, IO0::di, IO::uo),
will_not_call_mercury, "
+ StreamNames = ML_io_stream_names;
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__set_stream_names(StreamNames::in, IO0::di, IO::uo),
+ will_not_call_mercury, "
ML_io_stream_names = StreamNames;
update_io(IO0, IO);
").
@@ -2525,24 +2639,41 @@
% XXX design flaw with regard to unique modes
% and io__get_globals/3: the `Globals::uo' mode here is a lie.
-:- pragma c_code(io__get_globals(Globals::uo, IOState0::di, IOState::uo),
+:- pragma foreign_code("C",
+ io__get_globals(Globals::uo, IOState0::di, IOState::uo),
will_not_call_mercury, "
Globals = ML_io_user_globals;
update_io(IOState0, IOState);
").
-:- pragma c_code(io__set_globals(Globals::di, IOState0::di, IOState::uo),
+:- pragma foreign_code("C",
+ io__set_globals(Globals::di, IOState0::di, IOState::uo),
will_not_call_mercury, "
/* XXX need to globalize the memory */
ML_io_user_globals = Globals;
update_io(IOState0, IOState);
").
+:- pragma foreign_code("MC++",
+ io__get_globals(Globals::uo, IOState0::di, IOState::uo),
+ will_not_call_mercury, "
+ Globals = ML_io_user_globals;
+ update_io(IOState0, IOState);
+").
+
+:- pragma foreign_code("MC++",
+ io__set_globals(Globals::di, IOState0::di, IOState::uo),
+ will_not_call_mercury, "
+ ML_io_user_globals = Globals;
+ update_io(IOState0, IOState);
+").
+
io__progname_base(DefaultName, PrognameBase) -->
io__progname(DefaultName, Progname),
{ dir__basename(Progname, PrognameBase) }.
-:- pragma c_code(io__get_stream_id(Stream::in) = (Id::out),
+:- pragma foreign_code("C",
+ io__get_stream_id(Stream::in) = (Id::out),
will_not_call_mercury, "
/*
** Most of the time, we can just use the pointer to the stream
@@ -2560,6 +2691,14 @@
#endif
").
+:- pragma foreign_code("MC++",
+ io__get_stream_id(Stream::in) = (Id::out),
+ will_not_call_mercury, "
+ MR_MercuryFile mf = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ Id = mf->id;
+").
+
%-----------------------------------------------------------------------------%
@@ -2653,7 +2792,8 @@
:- pred io__gc_init(type_desc, type_desc, io__state, io__state).
:- mode io__gc_init(in, in, di, uo) is det.
-:- pragma c_code(io__gc_init(StreamNamesType::in, UserGlobalsType::in,
+:- pragma foreign_code("C",
+ io__gc_init(StreamNamesType::in, UserGlobalsType::in,
IO0::di, IO::uo), will_not_call_mercury, "
/* for Windows DLLs, we need to call GC_INIT() from each DLL */
#ifdef CONSERVATIVE_GC
@@ -2664,6 +2804,12 @@
update_io(IO0, IO);
").
+:- pragma foreign_code("MC++",
+ io__gc_init(_StreamNamesType::in, _UserGlobalsType::in,
+ IO0::di, IO::uo), will_not_call_mercury, "
+ update_io(IO0, IO);
+").
+
:- pred io__insert_std_stream_names(io__state, io__state).
:- mode io__insert_std_stream_names(di, uo) is det.
@@ -2741,7 +2887,7 @@
** They are also implemented for NU-Prolog in `io.nu.nl'.
*/
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include ""mercury_init.h""
#include ""mercury_wrapper.h""
@@ -2786,8 +2932,29 @@
int ML_fprintf(MercuryFile* mf, const char *format, ...);
").
-:- pragma c_code("
+:- pragma foreign_decl("MC++", "
+
+__gc struct MR_MercuryFileStruct {
+public:
+ IO::Stream *stream;
+ int line_number;
+ int id;
+};
+
+typedef __gc struct MR_MercuryFileStruct *MR_MercuryFile;
+#define MR_DownCast(Cast, Expr) dynamic_cast<Cast>(Expr)
+#define MR_UpCast(Cast, Expr) ((Cast) (Expr))
+
+#define initial_io_state() 0 /* some random number */
+#define update_io(r_src, r_dest) ((r_dest) = (r_src))
+#define final_io_state(r)
+
+
+").
+
+:- pragma foreign_code("C", "
+
MercuryFile mercury_stdin;
MercuryFile mercury_stdout;
MercuryFile mercury_stderr;
@@ -2834,8 +3001,42 @@
").
-:- pragma c_code("
+:- pragma foreign_code("MC++", "
+static MR_MercuryFile new_mercury_file(IO::Stream *stream, int line_number) {
+ MR_MercuryFile mf = new MR_MercuryFileStruct();
+ mf->stream = stream;
+ mf->line_number = line_number;
+ mf->id = next_id++;
+ return mf;
+}
+
+static MR_MercuryFile mercury_stdin =
+ new_mercury_file(Console::OpenStandardInput(), 1);
+static MR_MercuryFile mercury_stdout =
+ new_mercury_file(Console::OpenStandardOutput(), 1);
+static MR_MercuryFile mercury_stderr =
+ new_mercury_file(Console::OpenStandardError(), 1);
+
+static MR_MercuryFile mercury_stdin_binary =
+ new_mercury_file(0, 1);
+static MR_MercuryFile mercury_stdout_binary =
+ new_mercury_file(0, 1);
+
+static MR_MercuryFile mercury_current_text_input =
+ new_mercury_file(Console::OpenStandardInput(), 1);
+static MR_MercuryFile mercury_current_text_output =
+ new_mercury_file(Console::OpenStandardOutput(), 1);
+static MR_MercuryFile mercury_current_binary_input =
+ new_mercury_file(0, 1);
+static MR_MercuryFile mercury_current_binary_output =
+ new_mercury_file(0, 1);
+
+").
+
+
+:- pragma foreign_code("C", "
+
MercuryFile*
mercury_open(const char *filename, const char *type)
{
@@ -2851,11 +3052,41 @@
").
+:- pragma foreign_code("MC++", "
+
+MR_MercuryFile
+static mercury_open(MR_String filename, MR_String type)
+{
+ MR_MercuryFile mf = new MR_MercuryFileStruct();
+ IO::FileMode fa;
+ IO::Stream *stream;
+
+ // XXX get this right...
+ if (type == ""r"") {
+ fa = IO::FileMode::Open;
+ } else if (type == ""w"") {
+ fa = IO::FileMode::Append;
+ } else {
+ fa = IO::FileMode::OpenOrCreate;
+ }
+ stream = IO::File::Open(filename, fa);
+
+ if (!stream) {
+ return 0;
+ } else {
+ mf = new_mercury_file(stream, 1);
+ return mf;
+ }
+}
+
+").
+
+
:- pred throw_io_error(string::in) is erroneous.
:- pragma export(throw_io_error(in), "ML_throw_io_error").
throw_io_error(Message) :- throw(io_error(Message)).
-:- pragma c_code("
+:- pragma foreign_code("C", "
void
mercury_io_error(MercuryFile* mf, const char *format, ...)
@@ -2882,7 +3113,7 @@
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
void
mercury_output_error(MercuryFile *mf)
@@ -2893,7 +3124,7 @@
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
void
mercury_print_string(MercuryFile* mf, const char *s)
@@ -2909,8 +3140,25 @@
}
").
+
+:- pragma foreign_code("MC++", "
+
+static void
+mercury_print_string(MR_MercuryFile mf, MR_String s)
+{
+ IO::StreamWriter *w = new IO::StreamWriter(mf->stream);
+ w->Write(s);
+ w->Flush();
+ for (int i = 0; i < s->Length; i++) {
+ if (s->Chars[i] == '\\n') {
+ mf->line_number++;
+ }
+ }
+}
+
+").
-:- pragma c_code("
+:- pragma foreign_code("C", "
void
mercury_print_binary_string(MercuryFile* mf, const char *s)
@@ -2922,7 +3170,7 @@
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
int
mercury_getc(MercuryFile* mf)
@@ -2936,10 +3184,38 @@
").
+
+:- pragma foreign_code("MC++", "
+
+static void
+mercury_print_binary_string(MR_MercuryFile mf, MR_String s)
+{
+ IO::StreamWriter *w = new IO::StreamWriter(mf->stream);
+ w->Write(s);
+ w->Flush();
+}
+
+").
+
+:- pragma foreign_code("MC++", "
+
+static int
+mercury_getc(MR_MercuryFile mf)
+{
+ int c = mf->stream->ReadByte();
+ if (c == '\\n') {
+ mf->line_number++;
+ }
+ return c;
+}
+
+").
+
+
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
-:- pragma c_code("
+:- pragma foreign_code("C", "
#ifdef MR_NEW_MERCURYFILE_STRUCT
@@ -3087,9 +3363,26 @@
}
").
+
+:- pragma foreign_code("MC++", "
+
+static void
+mercury_close(MR_MercuryFile mf)
+{
+ if (mf != mercury_stdin &&
+ mf != mercury_stdout &&
+ mf != mercury_stderr)
+ {
+ mf->stream->Close();
+ mf->stream = 0;
+ }
+}
+
+").
-:- pragma c_code("
+:- pragma foreign_code("C", "
+
int
ML_fprintf(MercuryFile* mf, const char *format, ...)
{
@@ -3107,13 +3400,15 @@
/* input predicates */
-:- pragma c_code(io__read_char_code(File::in, CharCode::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__read_char_code(File::in, CharCode::out, IO0::di, IO::uo),
will_not_call_mercury, "
CharCode = mercury_getc((MercuryFile *) File);
update_io(IO0, IO);
").
-:- pragma c_code(io__putback_char(File::in, Character::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__putback_char(File::in, Character::in, IO0::di, IO::uo),
may_call_mercury, "{
MercuryFile* mf = (MercuryFile *) File;
if (Character == '\\n') {
@@ -3126,7 +3421,8 @@
update_io(IO0, IO);
}").
-:- pragma c_code(io__putback_byte(File::in, Character::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__putback_byte(File::in, Character::in, IO0::di, IO::uo),
may_call_mercury, "{
MercuryFile* mf = (MercuryFile *) File;
/* XXX should work even if ungetc() fails */
@@ -3136,15 +3432,41 @@
update_io(IO0, IO);
}").
+:- pragma foreign_code("MC++",
+ io__read_char_code(File::in, CharCode::out, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ MR_MercuryFile mf = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(File));
+ CharCode = mercury_getc(mf);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__putback_char(_File::in, _Character::in, IO0::di, IO::uo),
+ may_call_mercury, "{
+ MR_Runtime::SORRY(""foreign code for this function"");
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_code("MC++",
+ io__putback_byte(_File::in, _Character::in, IO0::di, IO::uo),
+ may_call_mercury, "{
+ MR_Runtime::SORRY(""foreign code for this function"");
+ update_io(IO0, IO);
+}").
+
+
/* output predicates - with output to mercury_current_text_output */
-:- pragma c_code(io__write_string(Message::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__write_string(Message::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "
mercury_print_string(mercury_current_text_output, Message);
update_io(IO0, IO);
").
-:- pragma c_code(io__write_char(Character::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__write_char(Character::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "
if (MR_PUTCH(*mercury_current_text_output, Character) < 0) {
mercury_output_error(mercury_current_text_output);
@@ -3155,7 +3477,8 @@
update_io(IO0, IO);
").
-:- pragma c_code(io__write_int(Val::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__write_int(Val::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "
if (ML_fprintf(mercury_current_text_output, ""%ld"", (long) Val) < 0) {
mercury_output_error(mercury_current_text_output);
@@ -3163,7 +3486,8 @@
update_io(IO0, IO);
").
-:- pragma c_code(io__write_float(Val::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__write_float(Val::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "
if (ML_fprintf(mercury_current_text_output, ""%#.15g"", Val) < 0) {
mercury_output_error(mercury_current_text_output);
@@ -3171,7 +3495,8 @@
update_io(IO0, IO);
").
-:- pragma c_code(io__write_byte(Byte::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__write_byte(Byte::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "
/* call putc with a strictly non-negative byte-sized integer */
if (MR_PUTCH(*mercury_current_binary_output,
@@ -3182,13 +3507,15 @@
update_io(IO0, IO);
").
-:- pragma c_code(io__write_bytes(Message::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__write_bytes(Message::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "{
mercury_print_binary_string(mercury_current_binary_output, Message);
update_io(IO0, IO);
}").
-:- pragma c_code(io__flush_output(IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__flush_output(IO0::di, IO::uo),
[may_call_mercury, thread_safe], "
if (MR_FLUSH(*mercury_current_text_output) < 0) {
mercury_output_error(mercury_current_text_output);
@@ -3196,7 +3523,8 @@
update_io(IO0, IO);
").
-:- pragma c_code(io__flush_binary_output(IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__flush_binary_output(IO0::di, IO::uo),
[may_call_mercury, thread_safe], "
if (MR_FLUSH(*mercury_current_binary_output) < 0) {
mercury_output_error(mercury_current_binary_output);
@@ -3204,6 +3532,73 @@
update_io(IO0, IO);
").
+:- pragma foreign_code("MC++",
+ io__write_string(Message::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "
+ mercury_print_string(mercury_current_text_output, Message);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__write_char(Character::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "
+ if (Character == '\\n') {
+ mercury_current_text_output->line_number++;
+ }
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__write_int(Val::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "
+ IO::StreamWriter *w = new IO::StreamWriter(
+ mercury_current_text_output->stream);
+ w->Write(Val.ToString());
+ w->Flush();
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__write_float(Val::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "
+ IO::StreamWriter *w = new IO::StreamWriter(
+ mercury_current_text_output->stream);
+ w->Write(Val.ToString());
+ w->Flush();
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__write_byte(Byte::in, _IO0::di, _IO::uo),
+ [may_call_mercury, thread_safe], "
+ IO::StreamWriter *w = new IO::StreamWriter(
+ mercury_current_text_output->stream);
+ w->Write(Byte.ToString());
+ w->Flush();
+").
+
+:- pragma foreign_code("MC++",
+ io__write_bytes(Message::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "{
+ mercury_print_binary_string(mercury_current_binary_output, Message);
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_code("MC++",
+ io__flush_output(IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "
+ mercury_current_text_output->stream->Flush();
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__flush_binary_output(IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "
+ mercury_current_binary_output->stream->Flush();
+ update_io(IO0, IO);
+").
+
+
/* moving about binary streams */
:- pred whence_to_int(io__whence::in, int::out) is det.
@@ -3219,8 +3614,9 @@
:- pred io__seek_binary_2(io__stream, int, int, io__state, io__state).
:- mode io__seek_binary_2(in, in, in, di, uo) is det.
-:- pragma c_code(io__seek_binary_2(Stream::in, Flag::in, Off::in,
- IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
+:- pragma foreign_code("C",
+ io__seek_binary_2(Stream::in, Flag::in, Off::in,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
"{
static const int seek_flags[] = { SEEK_SET, SEEK_CUR, SEEK_END };
MercuryFile *stream = (MercuryFile *) Stream;
@@ -3236,7 +3632,8 @@
IO = IO0;
}").
-:- pragma c_code(io__binary_stream_offset(Stream::in, Offset::out,
+:- pragma foreign_code("C",
+ io__binary_stream_offset(Stream::in, Offset::out,
IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
"{
MercuryFile *stream = (MercuryFile *) Stream;
@@ -3251,10 +3648,27 @@
IO = IO0;
}").
+:- pragma foreign_code("MC++",
+ io__seek_binary_2(_Stream::in, _Flag::in, _Off::in,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+ IO = IO0;
+}").
+:- pragma foreign_code("MC++",
+ io__binary_stream_offset(_Stream::in, _Offset::out,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+ IO = IO0;
+}").
+
+
/* output predicates - with output to the specified stream */
-:- pragma c_code(io__write_string(Stream::in, Message::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__write_string(Stream::in, Message::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe],
"{
MercuryFile *stream = (MercuryFile *) Stream;
@@ -3262,7 +3676,8 @@
update_io(IO0, IO);
}").
-:- pragma c_code(io__write_char(Stream::in, Character::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__write_char(Stream::in, Character::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe],
"{
MercuryFile *stream = (MercuryFile *) Stream;
@@ -3275,7 +3690,8 @@
update_io(IO0, IO);
}").
-:- pragma c_code(io__write_int(Stream::in, Val::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__write_int(Stream::in, Val::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "{
MercuryFile *stream = (MercuryFile *) Stream;
if (ML_fprintf(stream, ""%ld"", (long) Val) < 0) {
@@ -3284,7 +3700,8 @@
update_io(IO0, IO);
}").
-:- pragma c_code(io__write_float(Stream::in, Val::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__write_float(Stream::in, Val::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "{
MercuryFile *stream = (MercuryFile *) Stream;
if (ML_fprintf(stream, ""%#.15g"", Val) < 0) {
@@ -3293,7 +3710,8 @@
update_io(IO0, IO);
}").
-:- pragma c_code(io__write_byte(Stream::in, Byte::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__write_byte(Stream::in, Byte::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "{
MercuryFile *stream = (MercuryFile *) Stream;
/* call putc with a strictly non-negative byte-sized integer */
@@ -3303,14 +3721,16 @@
update_io(IO0, IO);
}").
-:- pragma c_code(io__write_bytes(Stream::in, Message::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__write_bytes(Stream::in, Message::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "{
MercuryFile *stream = (MercuryFile *) Stream;
mercury_print_binary_string(stream, Message);
update_io(IO0, IO);
}").
-:- pragma c_code(io__flush_output(Stream::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__flush_output(Stream::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "{
MercuryFile *stream = (MercuryFile *) Stream;
if (MR_FLUSH(*stream) < 0) {
@@ -3319,7 +3739,8 @@
update_io(IO0, IO);
}").
-:- pragma c_code(io__flush_binary_output(Stream::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__flush_binary_output(Stream::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "{
MercuryFile *stream = (MercuryFile *) Stream;
if (MR_FLUSH(*stream) < 0) {
@@ -3328,73 +3749,171 @@
update_io(IO0, IO);
}").
+:- pragma foreign_code("MC++",
+ io__write_string(Stream::in, Message::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe],
+"{
+ MR_MercuryFile stream = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ IO::StreamWriter *w = new IO::StreamWriter(
+ mercury_current_binary_output->stream);
+ w->Write(Message);
+ w->Flush();
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_code("MC++",
+ io__write_char(Stream::in, Character::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe],
+"{
+ MR_MercuryFile stream = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ IO::StreamWriter *w = new IO::StreamWriter(
+ mercury_current_binary_output->stream);
+ w->Write(Character);
+ w->Flush();
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_code("MC++",
+ io__write_int(Stream::in, Val::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "{
+ MR_MercuryFile stream = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ IO::StreamWriter *w = new IO::StreamWriter(
+ mercury_current_binary_output->stream);
+ w->Write(Val.ToString());
+ w->Flush();
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_code("MC++",
+ io__write_float(Stream::in, Val::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "{
+ MR_MercuryFile stream = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ IO::StreamWriter *w = new IO::StreamWriter(
+ mercury_current_binary_output->stream);
+ w->Write(Val.ToString());
+ w->Flush();
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_code("MC++",
+ io__write_byte(Stream::in, Byte::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "{
+ MR_MercuryFile stream = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ IO::StreamWriter *w = new IO::StreamWriter(
+ mercury_current_binary_output->stream);
+ w->Write(Byte.ToString());
+ w->Flush();
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_code("MC++",
+ io__write_bytes(Stream::in, Message::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "{
+ MR_MercuryFile stream = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ mercury_print_binary_string(stream, Message);
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_code("MC++",
+ io__flush_output(Stream::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "{
+ MR_MercuryFile stream = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ stream->stream->Flush();
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_code("MC++",
+ io__flush_binary_output(_Stream::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "{
+ MR_Runtime::SORRY(""foreign code for this function"");
+ update_io(IO0, IO);
+}").
+
+
/* stream predicates */
:- pragma export(io__stdin_stream(out, di, uo), "ML_io_stdin_stream").
:- pragma export(io__stdout_stream(out, di, uo), "ML_io_stdout_stream").
:- pragma export(io__stderr_stream(out, di, uo), "ML_io_stderr_stream").
-:- pragma c_code(io__stdin_stream(Stream::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__stdin_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe], "
Stream = (MR_Word) &mercury_stdin;
update_io(IO0, IO);
").
-:- pragma c_code(io__stdout_stream(Stream::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__stdout_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe], "
Stream = (MR_Word) &mercury_stdout;
update_io(IO0, IO);
").
-:- pragma c_code(io__stderr_stream(Stream::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__stderr_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe], "
Stream = (MR_Word) &mercury_stderr;
update_io(IO0, IO);
").
-:- pragma c_code(io__stdin_binary_stream(Stream::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__stdin_binary_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe], "
Stream = (MR_Word) &mercury_stdin_binary;
update_io(IO0, IO);
").
-:- pragma c_code(io__stdout_binary_stream(Stream::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__stdout_binary_stream(Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe], "
Stream = (MR_Word) &mercury_stdout_binary;
update_io(IO0, IO);
").
-:- pragma c_code(io__input_stream(Stream::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__input_stream(Stream::out, IO0::di, IO::uo),
will_not_call_mercury, "
Stream = (MR_Word) mercury_current_text_input;
update_io(IO0, IO);
").
-:- pragma c_code(io__output_stream(Stream::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__output_stream(Stream::out, IO0::di, IO::uo),
will_not_call_mercury, "
Stream = (MR_Word) mercury_current_text_output;
update_io(IO0, IO);
").
-:- pragma c_code(io__binary_input_stream(Stream::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__binary_input_stream(Stream::out, IO0::di, IO::uo),
will_not_call_mercury, "
Stream = (MR_Word) mercury_current_binary_input;
update_io(IO0, IO);
").
-:- pragma c_code(io__binary_output_stream(Stream::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__binary_output_stream(Stream::out, IO0::di, IO::uo),
will_not_call_mercury, "
Stream = (MR_Word) mercury_current_binary_output;
update_io(IO0, IO);
").
-:- pragma c_code(io__get_line_number(LineNum::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__get_line_number(LineNum::out, IO0::di, IO::uo),
will_not_call_mercury, "
LineNum = MR_line_number(*mercury_current_text_input);
update_io(IO0, IO);
").
-:- pragma c_code(
+:- pragma foreign_code("C",
io__get_line_number(Stream::in, LineNum::out, IO0::di, IO::uo),
will_not_call_mercury, "{
MercuryFile *stream = (MercuryFile *) Stream;
@@ -3402,13 +3921,14 @@
update_io(IO0, IO);
}").
-:- pragma c_code(io__set_line_number(LineNum::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__set_line_number(LineNum::in, IO0::di, IO::uo),
will_not_call_mercury, "
MR_line_number(*mercury_current_text_input) = LineNum;
update_io(IO0, IO);
").
-:- pragma c_code(
+:- pragma foreign_code("C",
io__set_line_number(Stream::in, LineNum::in, IO0::di, IO::uo),
will_not_call_mercury, "{
MercuryFile *stream = (MercuryFile *) Stream;
@@ -3416,13 +3936,14 @@
update_io(IO0, IO);
}").
-:- pragma c_code(io__get_output_line_number(LineNum::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__get_output_line_number(LineNum::out, IO0::di, IO::uo),
will_not_call_mercury, "
LineNum = MR_line_number(*mercury_current_text_output);
update_io(IO0, IO);
").
-:- pragma c_code(
+:- pragma foreign_code("C",
io__get_output_line_number(Stream::in, LineNum::out, IO0::di, IO::uo),
will_not_call_mercury, "{
MercuryFile *stream = (MercuryFile *) Stream;
@@ -3430,13 +3951,14 @@
update_io(IO0, IO);
}").
-:- pragma c_code(io__set_output_line_number(LineNum::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__set_output_line_number(LineNum::in, IO0::di, IO::uo),
will_not_call_mercury, "
MR_line_number(*mercury_current_text_output) = LineNum;
update_io(IO0, IO);
").
-:- pragma c_code(
+:- pragma foreign_code("C",
io__set_output_line_number(Stream::in, LineNum::in, IO0::di, IO::uo),
will_not_call_mercury, "{
MercuryFile *stream = (MercuryFile *) Stream;
@@ -3447,7 +3969,7 @@
% io__set_input_stream(NewStream, OldStream, IO0, IO1)
% Changes the current input stream to the stream specified.
% Returns the previous stream.
-:- pragma c_code(
+:- pragma foreign_code("C",
io__set_input_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
will_not_call_mercury, "
OutStream = (MR_Word) mercury_current_text_input;
@@ -3455,7 +3977,7 @@
update_io(IO0, IO);
").
-:- pragma c_code(
+:- pragma foreign_code("C",
io__set_output_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
will_not_call_mercury, "
OutStream = (MR_Word) mercury_current_text_output;
@@ -3463,7 +3985,7 @@
update_io(IO0, IO);
").
-:- pragma c_code(
+:- pragma foreign_code("C",
io__set_binary_input_stream(NewStream::in, OutStream::out,
IO0::di, IO::uo), will_not_call_mercury, "
OutStream = (MR_Word) mercury_current_binary_input;
@@ -3471,7 +3993,7 @@
update_io(IO0, IO);
").
-:- pragma c_code(
+:- pragma foreign_code("C",
io__set_binary_output_stream(NewStream::in, OutStream::out,
IO0::di, IO::uo), will_not_call_mercury, "
OutStream = (MR_Word) mercury_current_binary_output;
@@ -3479,12 +4001,179 @@
update_io(IO0, IO);
").
+:- pragma foreign_code("MC++",
+ io__stdin_stream(Stream::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "
+ MR_c_pointer_to_word(Stream, mercury_stdin);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__stdout_stream(Stream::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "
+ MR_c_pointer_to_word(Stream, mercury_stdout);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__stderr_stream(Stream::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "
+ MR_c_pointer_to_word(Stream, mercury_stderr);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__stdin_binary_stream(Stream::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "
+ MR_c_pointer_to_word(Stream, mercury_stdin_binary);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__stdout_binary_stream(Stream::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "
+ MR_c_pointer_to_word(Stream, mercury_stdout_binary);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__input_stream(Stream::out, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ MR_c_pointer_to_word(Stream, mercury_current_text_input);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__output_stream(Stream::out, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ MR_c_pointer_to_word(Stream, mercury_current_text_output);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__binary_input_stream(Stream::out, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ MR_c_pointer_to_word(Stream, mercury_current_binary_input);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__binary_output_stream(Stream::out, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ MR_c_pointer_to_word(Stream, mercury_current_binary_output);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__get_line_number(LineNum::out, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ LineNum = mercury_current_text_input->line_number;
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__get_line_number(Stream::in, LineNum::out, IO0::di, IO::uo),
+ will_not_call_mercury, "{
+ MR_MercuryFile stream = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ LineNum = stream->line_number;
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_code("MC++",
+ io__set_line_number(LineNum::in, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ mercury_current_text_input->line_number = LineNum;
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__set_line_number(Stream::in, LineNum::in, IO0::di, IO::uo),
+ will_not_call_mercury, "{
+ MR_MercuryFile stream = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ stream->line_number = LineNum;
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_code("MC++",
+ io__get_output_line_number(LineNum::out, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ LineNum = mercury_current_text_output->line_number;
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__get_output_line_number(Stream::in, LineNum::out, IO0::di, IO::uo),
+ will_not_call_mercury, "{
+ MR_MercuryFile stream = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ LineNum = stream->line_number;
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_code("MC++",
+ io__set_output_line_number(LineNum::in, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ mercury_current_text_output->line_number = LineNum;
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__set_output_line_number(Stream::in, LineNum::in, IO0::di, IO::uo),
+ will_not_call_mercury, "{
+ MR_MercuryFile stream = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ stream->line_number = LineNum;
+ update_io(IO0, IO);
+}").
+
+% io__set_input_stream(NewStream, OldStream, IO0, IO1)
+% Changes the current input stream to the stream specified.
+% Returns the previous stream.
+:- pragma foreign_code("MC++",
+ io__set_input_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ MR_c_pointer_to_word(OutStream, mercury_current_text_input);
+ mercury_current_text_input =
+ MR_DownCast(MR_MercuryFile, MR_word_to_c_pointer(NewStream));
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__set_output_stream(NewStream::in, OutStream::out, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ MR_c_pointer_to_word(OutStream, mercury_current_text_output);
+ mercury_current_text_output =
+ MR_DownCast(MR_MercuryFile, MR_word_to_c_pointer(NewStream));
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__set_binary_input_stream(NewStream::in, OutStream::out,
+ IO0::di, IO::uo), will_not_call_mercury, "
+ MR_c_pointer_to_word(OutStream, mercury_current_binary_input);
+ mercury_current_binary_input =
+ MR_DownCast(MR_MercuryFile, MR_word_to_c_pointer(NewStream));
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__set_binary_output_stream(NewStream::in, OutStream::out,
+ IO0::di, IO::uo), will_not_call_mercury, "
+ MR_c_pointer_to_word(OutStream, mercury_current_binary_output);
+ mercury_current_binary_output =
+ MR_DownCast(MR_MercuryFile, MR_word_to_c_pointer(NewStream));
+ update_io(IO0, IO);
+").
+
+
/* stream open/close predicates */
% io__do_open(File, Mode, ResultCode, Stream, IO0, IO1).
% Attempts to open a file in the specified mode.
% ResultCode is 0 for success, -1 for failure.
-:- pragma c_code(
+:- pragma foreign_code("C",
io__do_open(FileName::in, Mode::in, ResultCode::out,
Stream::out, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe],
@@ -3494,33 +4183,88 @@
update_io(IO0, IO);
").
-:- pragma c_code(io__close_input(Stream::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__close_input(Stream::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "
mercury_close((MercuryFile *) Stream);
update_io(IO0, IO);
").
-:- pragma c_code(io__close_output(Stream::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__close_output(Stream::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "
mercury_close((MercuryFile *) Stream);
update_io(IO0, IO);
").
-:- pragma c_code(io__close_binary_input(Stream::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__close_binary_input(Stream::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "
mercury_close((MercuryFile *) Stream);
update_io(IO0, IO);
").
-:- pragma c_code(io__close_binary_output(Stream::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__close_binary_output(Stream::in, IO0::di, IO::uo),
[may_call_mercury, thread_safe], "
mercury_close((MercuryFile *) Stream);
update_io(IO0, IO);
").
+% io__do_open(File, Mode, ResultCode, Stream, IO0, IO1).
+% Attempts to open a file in the specified mode.
+% ResultCode is 0 for success, -1 for failure.
+:- pragma foreign_code("MC++",
+ io__do_open(FileName::in, Mode::in, ResultCode::out,
+ Stream::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe],
+"
+ MR_MercuryFile mf = mercury_open(FileName, Mode);
+ MR_c_pointer_to_word(Stream, mf);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__close_input(Stream::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "
+ MR_MercuryFile mf = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ mercury_close(mf);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__close_output(Stream::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "
+ MR_MercuryFile mf = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ mercury_close(mf);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__close_binary_input(Stream::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "
+ MR_MercuryFile mf = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ mercury_close(mf);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__close_binary_output(Stream::in, IO0::di, IO::uo),
+ [may_call_mercury, thread_safe], "
+ MR_MercuryFile mf = MR_DownCast(MR_MercuryFile,
+ MR_word_to_c_pointer(Stream));
+ mercury_close(mf);
+ update_io(IO0, IO);
+").
+
+
/* miscellaneous predicates */
-:- pragma c_code(
+:- pragma foreign_code("C",
io__progname(DefaultProgname::in, PrognameOut::out, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe], "
if (MR_progname) {
@@ -3541,7 +4285,8 @@
update_io(IO0, IO);
").
-:- pragma c_code(io__command_line_arguments(Args::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__command_line_arguments(Args::out, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe], "
/* convert mercury_argv from a vector to a list */
{ int i = mercury_argc;
@@ -3554,19 +4299,21 @@
update_io(IO0, IO);
").
-:- pragma c_code(io__get_exit_status(ExitStatus::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__get_exit_status(ExitStatus::out, IO0::di, IO::uo),
will_not_call_mercury, "
ExitStatus = mercury_exit_status;
update_io(IO0, IO);
").
-:- pragma c_code(io__set_exit_status(ExitStatus::in, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__set_exit_status(ExitStatus::in, IO0::di, IO::uo),
will_not_call_mercury, "
mercury_exit_status = ExitStatus;
update_io(IO0, IO);
").
-:- pragma c_code(
+:- pragma foreign_code("C",
io__call_system_code(Command::in, Status::out, IO0::di, IO::uo),
will_not_call_mercury, "
Status = system(Command);
@@ -3600,19 +4347,89 @@
update_io(IO0, IO);
").
+:- pragma foreign_code("MC++",
+ io__progname(_DefaultProgname::in, _PrognameOut::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__command_line_arguments(Args::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "
+ MR_String arg_vector __gc[] = Environment::GetCommandLineArgs();
+ int i = arg_vector->Length;
+ MR_list_nil(Args);
+ /* We don't get the 0th argument: it is the executable name */
+ while (--i > 0) {
+ MR_list_cons(Args, arg_vector[i], Args);
+ }
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__get_exit_status(ExitStatus::out, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ ExitStatus = System::Environment::get_ExitCode();
+ MR_Runtime::SORRY(""foreign code for this function"");
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__set_exit_status(ExitStatus::in, IO0::di, IO::uo),
+ will_not_call_mercury, "
+ System::Environment::set_ExitCode(ExitStatus);
+ update_io(IO0, IO);
+").
+
+:- pragma foreign_code("MC++",
+ io__call_system_code(Command::in, Status::out, IO0::di, IO::uo),
+ will_not_call_mercury, "
+
+ // XXX This could be better... need to handle embedded spaces.
+ MR_Integer index = Command->IndexOf("" "");
+ MR_String commandstr = Command->Substring(index);
+ MR_String argstr = Command->Remove(0, index);
+ // XXX This seems to be missing...
+ MR_Runtime::SORRY(""foreign code for this function"");
+// Diagnostics::Process::Start(commandstr, argstr);
+ Status = 0;
+ update_io(IO0, IO);
+").
+
+
/*---------------------------------------------------------------------------*/
/* io__getenv and io__putenv, from io.m */
-:- pragma c_code(io__getenv(Var::in, Value::out), will_not_call_mercury, "{
+:- pragma foreign_code("C",
+ io__getenv(Var::in, Value::out), will_not_call_mercury,
+"{
Value = getenv(Var);
SUCCESS_INDICATOR = (Value != 0);
}").
-:- pragma c_code(io__putenv(VarAndValue::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ io__putenv(VarAndValue::in), will_not_call_mercury,
+"
SUCCESS_INDICATOR = (putenv(VarAndValue) == 0);
").
+:- pragma foreign_code("MC++",
+ io__getenv(Var::in, Value::out), will_not_call_mercury,
+"{
+ Value = Environment::GetEnvironmentVariable(Var);
+ SUCCESS_INDICATOR = (Value != 0);
+}").
+
+:- pragma foreign_code("MC++",
+ io__putenv(_VarAndValue::in), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""No SetEnvironmentVariable method appears to be available."");
+ SUCCESS_INDICATOR = 0;
+").
+
+
/*---------------------------------------------------------------------------*/
io__tmpnam(Name) -->
@@ -3660,7 +4477,7 @@
%#include <stdio.h>
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
@@ -3673,11 +4490,12 @@
extern long ML_io_tempnam_counter;
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
long ML_io_tempnam_counter = 0;
").
-:- pragma c_code(io__do_make_temp(Dir::in, Prefix::in, FileName::out,
+:- pragma foreign_code("C",
+ io__do_make_temp(Dir::in, Prefix::in, FileName::out,
Error::out, ErrorMessage::out, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe],
"{
@@ -3727,9 +4545,19 @@
update_io(IO0, IO);
}").
+:- pragma foreign_code("MC++",
+ io__do_make_temp(_Dir::in, _Prefix::in, _FileName::out,
+ _Error::out, _ErrorMessage::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+ update_io(IO0, IO);
+}").
+
+
/*---------------------------------------------------------------------------*/
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include <string.h>
#include <errno.h>
@@ -3784,7 +4612,8 @@
:- pred io__remove_file_2(string, int, string, io__state, io__state).
:- mode io__remove_file_2(in, out, out, di, uo) is det.
-:- pragma c_code(io__remove_file_2(FileName::in, RetVal::out, RetStr::out,
+:- pragma foreign_code("C",
+ io__remove_file_2(FileName::in, RetVal::out, RetStr::out,
IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
"{
RetVal = remove(FileName);
@@ -3793,6 +4622,17 @@
update_io(IO0, IO);
}").
+:- pragma foreign_code("MC++",
+ io__remove_file_2(FileName::in, RetVal::out, RetStr::out,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
+"{
+ System::IO::File::Delete(FileName);
+ RetVal = 0;
+ RetStr = """";
+ update_io(IO0, IO);
+}").
+
+
io__rename_file(OldFileName, NewFileName, Result, IO0, IO) :-
io__rename_file_2(OldFileName, NewFileName, Res, ResString, IO0, IO),
( Res \= 0 ->
@@ -3804,8 +4644,9 @@
:- pred io__rename_file_2(string, string, int, string, io__state, io__state).
:- mode io__rename_file_2(in, in, out, out, di, uo) is det.
-:- pragma c_code(io__rename_file_2(OldFileName::in, NewFileName::in,
- RetVal::out, RetStr::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ io__rename_file_2(OldFileName::in, NewFileName::in,
+ RetVal::out, RetStr::out, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe],
"{
#ifdef _MSC_VER
@@ -3817,6 +4658,16 @@
MR_PROC_LABEL, RetStr);
update_io(IO0, IO);
}").
+
+:- pragma foreign_code("MC++",
+ io__rename_file_2(_OldFileName::in, _NewFileName::in,
+ _RetVal::out, _RetStr::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+ update_io(IO0, IO);
+}").
+
/*---------------------------------------------------------------------------*/
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.52
diff -u -r1.52 library.m
--- library/library.m 2000/11/12 05:51:01 1.52
+++ library/library.m 2000/12/01 03:34:04
@@ -48,7 +48,9 @@
% at configuration time, because that would cause bootstrapping problems --
% might not have a Mercury compiler around to compile library.m with.
-:- pragma c_code(library__version(Version::out), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ library__version(Version::out), will_not_call_mercury,
+"
MR_ConstString version_string =
MR_VERSION "", configured for "" MR_FULLARCH;
/*
@@ -56,6 +58,17 @@
** with type String rather than MR_ConstString.
*/
Version = (MR_String) (MR_Word) version_string;
+").
+
+:- pragma foreign_code("MC++", "
+ #include ""mercury_conf.h""
+").
+
+:- pragma foreign_code("MC++",
+ library__version(Version::out), will_not_call_mercury,
+"
+ Version = String::Concat(MR_VERSION,
+ "", configured for "", MR_FULLARCH);
").
%---------------------------------------------------------------------------%
Index: library/math.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/math.m,v
retrieving revision 1.25
diff -u -r1.25 math.m
--- library/math.m 2000/11/01 07:01:40 1.25
+++ library/math.m 2000/12/01 03:34:04
@@ -206,7 +206,7 @@
% These operations are mostly implemented using the C interface.
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include <math.h>
@@ -225,10 +225,17 @@
void ML_math_domain_error(const char *where);
-"). % end pragma c_header_code
+"). % end pragma foreign_decl
-:- pragma c_code("
+:- pragma foreign_decl("MC++", "
+ // This is not defined in the .NET Frameworks.
+
+ #define ML_FLOAT_LN2 0.69314718055994530941
+").
+
+:- pragma foreign_code("C", "
+
#include ""mercury_trace_base.h""
#include <stdio.h>
@@ -248,55 +255,99 @@
#endif
exit(1);
}
+
+"). % end pragma foreign_code
-"). % end pragma c_code
+:- pragma foreign_code("MC++", "
+/*
+** Handle domain errors.
+*/
+static void
+ML_math_domain_error(MR_String where)
+{
+ throw new mercury_exception(where);
+}
+
+"). % end pragma foreign_code
+
%
% Mathematical constants from math.m
%
% Pythagoras' number
-:- pragma c_code(math__pi = (Pi::out), [will_not_call_mercury, thread_safe],"
+:- pragma foreign_code("C",
+ math__pi = (Pi::out), [will_not_call_mercury, thread_safe],"
Pi = ML_FLOAT_PI;
").
+:- pragma foreign_code("MC++",
+ math__pi = (Pi::out), [will_not_call_mercury, thread_safe],"
+ Pi = Math::PI;
+").
% Base of natural logarithms
-:- pragma c_code(math__e = (E::out), [will_not_call_mercury, thread_safe],"
+:- pragma foreign_code("C",
+ math__e = (E::out), [will_not_call_mercury, thread_safe],"
E = ML_FLOAT_E;
").
+:- pragma foreign_code("MC++",
+ math__e = (E::out), [will_not_call_mercury, thread_safe],"
+ E = Math::E;
+").
%
% math__ceiling(X) = Ceil is true if Ceil is the smallest integer
% not less than X.
%
-:- pragma c_code(math__ceiling(Num::in) = (Ceil::out),
+:- pragma foreign_code("C",
+ math__ceiling(Num::in) = (Ceil::out),
[will_not_call_mercury, thread_safe],"
Ceil = ceil(Num);
").
+:- pragma foreign_code("MC++",
+ math__ceiling(Num::in) = (Ceil::out),
+ [will_not_call_mercury, thread_safe],"
+ Ceil = Math::Ceil(Num);
+").
%
% math__floor(X) = Floor is true if Floor is the largest integer
% not greater than X.
%
-:- pragma c_code(math__floor(Num::in) = (Floor::out),
+:- pragma foreign_code("C",
+ math__floor(Num::in) = (Floor::out),
[will_not_call_mercury, thread_safe],"
Floor = floor(Num);
").
+:- pragma foreign_code("MC++",
+ math__floor(Num::in) = (Floor::out),
+ [will_not_call_mercury, thread_safe],"
+ Floor = Math::Floor(Num);
+").
%
% math__round(X) = Round is true if Round is the integer
% closest to X. If X has a fractional component of 0.5,
% it is rounded up.
%
-:- pragma c_code(math__round(Num::in) = (Rounded::out),
+:- pragma foreign_code("C",
+ math__round(Num::in) = (Rounded::out),
[will_not_call_mercury, thread_safe],"
Rounded = floor(Num+0.5);
").
+:- pragma foreign_code("MC++",
+ math__round(Num::in) = (Rounded::out),
+ [will_not_call_mercury, thread_safe],"
+ // XXX the semantics of Math::Round() are not the same as ours.
+ // Unfortunately they are better (round to nearest even number).
+ Rounded = Math::Floor(Num+0.5);
+").
%
% math__truncate(X) = Trunc is true if Trunc is the integer
% closest to X such that |Trunc| =< |X|.
%
-:- pragma c_code(math__truncate(X::in) = (Trunc::out),
+:- pragma foreign_code("C",
+ math__truncate(X::in) = (Trunc::out),
[will_not_call_mercury, thread_safe],"
if (X < 0.0) {
Trunc = ceil(X);
@@ -304,6 +355,15 @@
Trunc = floor(X);
}
").
+:- pragma foreign_code("MC++",
+ math__truncate(X::in) = (Trunc::out),
+ [will_not_call_mercury, thread_safe],"
+ if (X < 0.0) {
+ Trunc = Math::Ceil(X);
+ } else {
+ Trunc = Math::Floor(X);
+ }
+").
%
% math__sqrt(X) = Sqrt is true if Sqrt is the positive square
@@ -312,7 +372,7 @@
% Domain restrictions:
% X >= 0
%
-:- pragma c_code(math__sqrt(X::in) = (SquareRoot::out),
+:- pragma foreign_code("C", math__sqrt(X::in) = (SquareRoot::out),
[will_not_call_mercury, thread_safe], "
#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X < 0.0) {
@@ -321,6 +381,16 @@
#endif
SquareRoot = sqrt(X);
").
+:- pragma foreign_code("MC++", math__sqrt(X::in) = (SquareRoot::out),
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
+ if (X < 0.0) {
+ ML_math_domain_error(""math__sqrt"");
+ }
+#endif
+ SquareRoot = Math::Sqrt(X);
+").
+
%
% math__solve_quadratic(A, B, C) = Roots is true if Roots are
@@ -373,7 +443,7 @@
% X >= 0
% X = 0 implies Y > 0
%
-:- pragma c_code(math__pow(X::in, Y::in) = (Res::out),
+:- pragma foreign_code("C", math__pow(X::in, Y::in) = (Res::out),
[will_not_call_mercury, thread_safe], "
#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X < 0.0) {
@@ -392,14 +462,38 @@
#endif
").
+:- pragma foreign_code("MC++", math__pow(X::in, Y::in) = (Res::out),
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
+ if (X < 0.0) {
+ ML_math_domain_error(""math__pow"");
+ }
+ if (X == 0.0) {
+ if (Y <= 0.0) {
+ ML_math_domain_error(""math__pow"");
+ }
+ Res = 0.0;
+ } else {
+ Res = Math::Pow(X, Y);
+ }
+#else
+ Res = Math::Pow(X, Y);
+#endif
+").
+
+
%
% math__exp(X) = Exp is true if Exp is X raised to the
% power of e.
%
-:- pragma c_code(math__exp(X::in) = (Exp::out),
+:- pragma foreign_code("C", math__exp(X::in) = (Exp::out),
[will_not_call_mercury, thread_safe],"
Exp = exp(X);
").
+:- pragma foreign_code("MC++", math__exp(X::in) = (Exp::out),
+ [will_not_call_mercury, thread_safe],"
+ Exp = Math::Exp(X);
+").
%
% math__ln(X) = Log is true if Log is the natural logarithm
@@ -408,7 +502,7 @@
% Domain restrictions:
% X > 0
%
-:- pragma c_code(math__ln(X::in) = (Log::out),
+:- pragma foreign_code("C", math__ln(X::in) = (Log::out),
[will_not_call_mercury, thread_safe], "
#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X <= 0.0) {
@@ -417,6 +511,15 @@
#endif
Log = log(X);
").
+:- pragma foreign_code("MC++", math__ln(X::in) = (Log::out),
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
+ if (X <= 0.0) {
+ ML_math_domain_error(""math__ln"");
+ }
+#endif
+ Log = Math::Log(X);
+").
%
% math__log10(X) = Log is true if Log is the logarithm to
@@ -425,7 +528,7 @@
% Domain restrictions:
% X > 0
%
-:- pragma c_code(math__log10(X::in) = (Log10::out),
+:- pragma foreign_code("C", math__log10(X::in) = (Log10::out),
[will_not_call_mercury, thread_safe], "
#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X <= 0.0) {
@@ -434,6 +537,15 @@
#endif
Log10 = log10(X);
").
+:- pragma foreign_code("MC++", math__log10(X::in) = (Log10::out),
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
+ if (X <= 0.0) {
+ ML_math_domain_error(""math__log10"");
+ }
+#endif
+ Log10 = Math::Log10(X);
+").
%
% math__log2(X) = Log is true if Log is the logarithm to
@@ -442,7 +554,7 @@
% Domain restrictions:
% X > 0
%
-:- pragma c_code(math__log2(X::in) = (Log2::out),
+:- pragma foreign_code("C", math__log2(X::in) = (Log2::out),
[will_not_call_mercury, thread_safe], "
#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X <= 0.0) {
@@ -451,6 +563,15 @@
#endif
Log2 = log(X) / ML_FLOAT_LN2;
").
+:- pragma foreign_code("MC++", math__log2(X::in) = (Log2::out),
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
+ if (X <= 0.0) {
+ ML_math_domain_error(""math__log2"");
+ }
+#endif
+ Log2 = Math::Log(X) / ML_FLOAT_LN2;
+").
%
% math__log(B, X) = Log is true if Log is the logarithm to
@@ -461,7 +582,7 @@
% B > 0
% B \= 1
%
-:- pragma c_code(math__log(B::in, X::in) = (Log::out),
+:- pragma foreign_code("C", math__log(B::in, X::in) = (Log::out),
[will_not_call_mercury, thread_safe], "
#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X <= 0.0 || B <= 0.0) {
@@ -473,30 +594,56 @@
#endif
Log = log(X)/log(B);
").
+:- pragma foreign_code("MC++", math__log(B::in, X::in) = (Log::out),
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
+ if (X <= 0.0 || B <= 0.0) {
+ ML_math_domain_error(""math__log"");
+ }
+ if (B == 1.0) {
+ ML_math_domain_error(""math__log"");
+ }
+#endif
+ Log = Math::Log(X,B);
+").
+
%
% math__sin(X) = Sin is true if Sin is the sine of X.
%
-:- pragma c_code(math__sin(X::in) = (Sin::out),
+:- pragma foreign_code("C", math__sin(X::in) = (Sin::out),
[will_not_call_mercury, thread_safe],"
Sin = sin(X);
").
+:- pragma foreign_code("MC++", math__sin(X::in) = (Sin::out),
+ [will_not_call_mercury, thread_safe],"
+ Sin = Math::Sin(X);
+").
+
%
% math__cos(X) = Sin is true if Cos is the cosine of X.
%
-:- pragma c_code(math__cos(X::in) = (Cos::out),
+:- pragma foreign_code("C", math__cos(X::in) = (Cos::out),
[will_not_call_mercury, thread_safe],"
Cos = cos(X);
").
+:- pragma foreign_code("MC++", math__cos(X::in) = (Cos::out),
+ [will_not_call_mercury, thread_safe],"
+ Cos = Math::Cos(X);
+").
%
% math__tan(X) = Tan is true if Tan is the tangent of X.
%
-:- pragma c_code(math__tan(X::in) = (Tan::out),
+:- pragma foreign_code("C", math__tan(X::in) = (Tan::out),
[will_not_call_mercury, thread_safe],"
Tan = tan(X);
").
+:- pragma foreign_code("MC++", math__tan(X::in) = (Tan::out),
+ [will_not_call_mercury, thread_safe],"
+ Tan = Math::Tan(X);
+").
%
% math__asin(X) = ASin is true if ASin is the inverse
@@ -505,7 +652,7 @@
% Domain restrictions:
% X must be in the range [-1,1]
%
-:- pragma c_code(math__asin(X::in) = (ASin::out),
+:- pragma foreign_code("C", math__asin(X::in) = (ASin::out),
[will_not_call_mercury, thread_safe], "
#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X < -1.0 || X > 1.0) {
@@ -514,6 +661,15 @@
#endif
ASin = asin(X);
").
+:- pragma foreign_code("MC++", math__asin(X::in) = (ASin::out),
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
+ if (X < -1.0 || X > 1.0) {
+ ML_math_domain_error(""math__asin"");
+ }
+#endif
+ ASin = Math::Asin(X);
+").
%
% math__acos(X) = ACos is true if ACos is the inverse
@@ -522,7 +678,7 @@
% Domain restrictions:
% X must be in the range [-1,1]
%
-:- pragma c_code(math__acos(X::in) = (ACos::out),
+:- pragma foreign_code("C", math__acos(X::in) = (ACos::out),
[will_not_call_mercury, thread_safe], "
#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
if (X < -1.0 || X > 1.0) {
@@ -531,51 +687,81 @@
#endif
ACos = acos(X);
").
+:- pragma foreign_code("MC++", math__acos(X::in) = (ACos::out),
+ [will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
+ if (X < -1.0 || X > 1.0) {
+ ML_math_domain_error(""math__acos"");
+ }
+#endif
+ ACos = Math::Acos(X);
+").
+
%
% math__atan(X) = ATan is true if ATan is the inverse
% tangent of X, where ATan is in the range [-pi/2,pi/2].
%
-:- pragma c_code(math__atan(X::in) = (ATan::out),
+:- pragma foreign_code("C", math__atan(X::in) = (ATan::out),
[will_not_call_mercury, thread_safe],"
ATan = atan(X);
").
+:- pragma foreign_code("MC++", math__atan(X::in) = (ATan::out),
+ [will_not_call_mercury, thread_safe],"
+ ATan = Math::Atan(X);
+").
%
% math__atan2(Y, X) = ATan is true if ATan is the inverse
% tangent of Y/X, where ATan is in the range [-pi,pi].
%
-:- pragma c_code(math__atan2(Y::in, X::in) = (ATan2::out),
+:- pragma foreign_code("C", math__atan2(Y::in, X::in) = (ATan2::out),
[will_not_call_mercury, thread_safe], "
ATan2 = atan2(Y, X);
").
+:- pragma foreign_code("MC++", math__atan2(Y::in, X::in) = (ATan2::out),
+ [will_not_call_mercury, thread_safe], "
+ ATan2 = Math::Atan2(Y, X);
+").
%
% math__sinh(X) = Sinh is true if Sinh is the hyperbolic
% sine of X.
%
-:- pragma c_code(math__sinh(X::in) = (Sinh::out),
+:- pragma foreign_code("C", math__sinh(X::in) = (Sinh::out),
[will_not_call_mercury, thread_safe],"
Sinh = sinh(X);
").
+:- pragma foreign_code("MC++", math__sinh(X::in) = (Sinh::out),
+ [will_not_call_mercury, thread_safe],"
+ Sinh = Math::Sinh(X);
+").
%
% math__cosh(X) = Cosh is true if Cosh is the hyperbolic
% cosine of X.
%
-:- pragma c_code(math__cosh(X::in) = (Cosh::out),
+:- pragma foreign_code("C", math__cosh(X::in) = (Cosh::out),
[will_not_call_mercury, thread_safe],"
Cosh = cosh(X);
").
+:- pragma foreign_code("MC++", math__cosh(X::in) = (Cosh::out),
+ [will_not_call_mercury, thread_safe],"
+ Cosh = Math::Cosh(X);
+").
%
% math__tanh(X) = Tanh is true if Tanh is the hyperbolic
% tangent of X.
%
-:- pragma c_code(math__tanh(X::in) = (Tanh::out),
+:- pragma foreign_code("C", math__tanh(X::in) = (Tanh::out),
[will_not_call_mercury, thread_safe],"
Tanh = tanh(X);
").
+:- pragma foreign_code("MC++", math__tanh(X::in) = (Tanh::out),
+ [will_not_call_mercury, thread_safe],"
+ Tanh = Math::Tanh(X);
+").
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -760,287 +946,32 @@
:- implementation.
-% These operations are all implemented using the C interface.
+% These operations are all implemented in terms of the functional versions.
-
-%
-% Mathematical constants from math.m
-%
- % Pythagoras' number
-:- pragma c_code(math__pi(Pi::out), [will_not_call_mercury, thread_safe],
- "Pi = ML_FLOAT_PI;").
-
- % Base of natural logarithms
-:- pragma c_code(math__e(E::out), [will_not_call_mercury, thread_safe],
- "E = ML_FLOAT_E;").
-
-%
-% math__ceiling(X, Ceil) is true if Ceil is the smallest integer
-% not less than X.
-%
-:- pragma c_code(math__ceiling(Num::in, Ceil::out),
- [will_not_call_mercury, thread_safe],
- "Ceil = ceil(Num);").
-
-%
-% math__floor(X, Floor) is true if Floor is the largest integer
-% not greater than X.
-%
-:- pragma c_code(math__floor(Num::in, Floor::out),
- [will_not_call_mercury, thread_safe],
- "Floor = floor(Num);").
-%
-% math__round(X, Round) is true if Round is the integer
-% closest to X. If X has a fractional component of 0.5,
-% it is rounded up.
-%
-:- pragma c_code(math__round(Num::in, Rounded::out),
- [will_not_call_mercury, thread_safe], "
- Rounded = floor(Num+0.5);
-").
-
-%
-% math__truncate(X, Trunc) is true if Trunc is the integer
-% closest to X such that |Trunc| =< |X|.
-%
-:- pragma c_code(math__truncate(X::in, Trunc::out),
- [will_not_call_mercury, thread_safe], "
- if (X < 0.0) {
- Trunc = ceil(X);
- } else {
- Trunc = floor(X);
- }
-").
-
-%
-% math__sqrt(X, Sqrt) is true if Sqrt is the positive square
-% root of X.
-%
-% Domain restrictions:
-% X >= 0
-%
-:- pragma c_code(math__sqrt(X::in, SquareRoot::out),
- [will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X < 0.0) {
- ML_math_domain_error(""math__sqrt"");
- }
-#endif
- SquareRoot = sqrt(X);
-").
-
-%
-% math__pow(X, Y, Res) is true if Res is X raised to the
-% power of Y.
-%
-% Domain restrictions:
-% X >= 0
-% X = 0 implies Y > 0
-%
-:- pragma c_code(math__pow(X::in, Y::in, Res::out),
- [will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X < 0.0) {
- ML_math_domain_error(""math__pow"");
- }
- if (X == 0.0) {
- if (Y <= 0.0) {
- ML_math_domain_error(""math__pow"");
- }
- Res = 0.0;
- } else {
- Res = pow(X, Y);
- }
-#else
- Res = pow(X, Y);
-#endif
-").
-
-%
-% math__exp(X, Exp) is true if Exp is X raised to the
-% power of e.
-%
-:- pragma c_code(math__exp(X::in, Exp::out),
- [will_not_call_mercury, thread_safe], "
- Exp = exp(X);
-").
-
-%
-% math__ln(X, Log) is true if Log is the natural logarithm
-% of X.
-%
-% Domain restrictions:
-% X > 0
-%
-:- pragma c_code(math__ln(X::in, Log::out),
- [will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X <= 0.0) {
- ML_math_domain_error(""math__ln"");
- }
-#endif
- Log = log(X);
-").
-
-%
-% math__log10(X, Log) is true if Log is the logarithm to
-% base 10 of X.
-%
-% Domain restrictions:
-% X > 0
-%
-:- pragma c_code(math__log10(X::in, Log10::out),
- [will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X <= 0.0) {
- ML_math_domain_error(""math__log10"");
- }
-#endif
- Log10 = log10(X);
-").
-
-%
-% math__log2(X, Log) is true if Log is the logarithm to
-% base 2 of X.
-%
-% Domain restrictions:
-% X > 0
-%
-:- pragma c_code(math__log2(X::in, Log2::out),
- [will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X <= 0.0) {
- ML_math_domain_error(""math__log2"");
- }
-#endif
- Log2 = log(X) / ML_FLOAT_LN2;
-").
-
-%
-% math__log(B, X, Log) is true if Log is the logarithm to
-% base B of X.
-%
-% Domain restrictions:
-% X > 0
-% B > 0
-% B \= 1
-%
-:- pragma c_code(math__log(B::in, X::in, Log::out),
- [will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X <= 0.0 || B <= 0.0) {
- ML_math_domain_error(""math__log"");
- }
- if (B == 1.0) {
- ML_math_domain_error(""math__log"");
- }
-#endif
- Log = log(X)/log(B);
-").
-
-%
-% math__sin(X, Sin) is true if Sin is the sine of X.
-%
-:- pragma c_code(math__sin(X::in, Sin::out),
- [will_not_call_mercury, thread_safe], "
- Sin = sin(X);
-").
-
-%
-% math__cos(X, Cos) is true if Cos is the cosine of X.
-%
-:- pragma c_code(math__cos(X::in, Cos::out),
- [will_not_call_mercury, thread_safe], "
- Cos = cos(X);
-").
-
-%
-% math__tan(X, Tan) is true if Tan is the tangent of X.
-%
-:- pragma c_code(math__tan(X::in, Tan::out),
- [will_not_call_mercury, thread_safe], "
- Tan = tan(X);
-").
-
-%
-% math__asin(X, ASin) is true if ASin is the inverse
-% sine of X, where ASin is in the range [-pi/2,pi/2].
-%
-% Domain restrictions:
-% X must be in the range [-1,1]
-%
-:- pragma c_code(math__asin(X::in, ASin::out),
- [will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X < -1.0 || X > 1.0) {
- ML_math_domain_error(""math__asin"");
- }
-#endif
- ASin = asin(X);
-").
-
-%
-% math__acos(X, ACos) is true if ACos is the inverse
-% cosine of X, where ACos is in the range [0, pi].
-%
-% Domain restrictions:
-% X must be in the range [-1,1]
-%
-:- pragma c_code(math__acos(X::in, ACos::out),
- [will_not_call_mercury, thread_safe], "
-#ifndef ML_OMIT_MATH_DOMAIN_CHECKS
- if (X < -1.0 || X > 1.0) {
- ML_math_domain_error(""math__acos"");
- }
-#endif
- ACos = asin(X);
-").
-
-%
-% math__atan(X, ATan) is true if ATan is the inverse
-% tangent of X, where ATan is in the range [-pi/2,pi/2].
-%
-:- pragma c_code(math__atan(X::in, ATan::out),
- [will_not_call_mercury, thread_safe], "
- ATan = atan(X);
-").
-
-%
-% math__atan2(Y, X, ATan) is true if ATan is the inverse
-% tangent of Y/X, where ATan is in the range [-pi,pi].
-%
-:- pragma c_code(math__atan2(Y::in, X::in, ATan2::out),
- [will_not_call_mercury, thread_safe], "
- ATan2 = atan2(Y, X);
-").
-
-%
-% math__sinh(X, Sinh) is true if Sinh is the hyperbolic
-% sine of X.
-%
-:- pragma c_code(math__sinh(X::in, Sinh::out),
- [will_not_call_mercury, thread_safe], "
- Sinh = sinh(X);
-").
-
-%
-% math__cosh(X, Cosh) is true if Cosh is the hyperbolic
-% cosine of X.
-%
-:- pragma c_code(math__cosh(X::in, Cosh::out),
- [will_not_call_mercury, thread_safe], "
- Cosh = cosh(X);
-").
-
-%
-% math__tanh(X, Tanh) is true if Tanh is the hyperbolic
-% tangent of X.
-%
-:- pragma c_code(math__tanh(X::in, Tanh::out),
- [will_not_call_mercury, thread_safe], "
- Tanh = tanh(X);
-").
+pi(pi).
+e(e).
+ceiling(X, ceiling(X)).
+floor(X, floor(X)).
+round(X, round(X)).
+truncate(X, truncate(X)).
+sqrt(X, sqrt(X)).
+pow(X, Y, pow(X, Y)).
+exp(X, exp(X)).
+ln(X, ln(X)).
+log10(X, log10(X)).
+log2(X, log2(X)).
+log(X, Y, log(X, Y)).
+sin(X, sin(X)).
+cos(X, cos(X)).
+tan(X, tan(X)).
+asin(X, asin(X)).
+acos(X, acos(X)).
+atan(X, atan(X)).
+atan2(X, Y, atan2(X, Y)).
+sinh(X, sinh(X)).
+cosh(X, cosh(X)).
+tanh(X, tanh(X)).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: library/ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/ops.m,v
retrieving revision 1.32
diff -u -r1.32 ops.m
--- library/ops.m 2000/09/19 04:46:50 1.32
+++ library/ops.m 2000/12/01 03:34:04
@@ -80,7 +80,8 @@
:- implementation.
-:- type ops__table ---> ops__table. % XXX
+ % XXX for some reason I get a determinism warning on this one.
+:- type ops__table ---> ops__table ; aaa. % XXX
:- type ops__category ---> before ; after.
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.58
diff -u -r1.58 private_builtin.m
--- library/private_builtin.m 2000/11/23 02:00:01 1.58
+++ library/private_builtin.m 2000/12/03 06:21:36
@@ -161,10 +161,17 @@
:- pred builtin_strcmp(int, string, string).
:- mode builtin_strcmp(out, in, in) is det.
-:- pragma c_code(builtin_strcmp(Res::out, S1::in, S2::in),
+:- pragma foreign_code("C", builtin_strcmp(Res::out, S1::in, S2::in),
[will_not_call_mercury, thread_safe],
"Res = strcmp(S1, S2);").
+:- pragma foreign_code("MC++", builtin_strcmp(Res::out, S1::in, S2::in),
+ [will_not_call_mercury, thread_safe],
+"
+ Res = String::Compare(S1, S2);
+").
+
+
builtin_unify_float(F, F).
builtin_compare_float(R, F1, F2) :-
@@ -235,7 +242,7 @@
error("internal error in compare/3").
% XXX These could be implemented more efficiently using
- % `pragma c_code' -- the implementation below does some
+ % `pragma foreign_code' -- the implementation below does some
% unnecessary memory allocatation.
typed_unify(X, Y) :- univ(X) = univ(Y).
typed_compare(R, X, Y) :- compare(R, univ(X), univ(Y)).
@@ -320,7 +327,7 @@
% The definitions for type_ctor_info/1 and type_info/1.
-:- pragma c_code("
+:- pragma foreign_code("C", "
#ifdef MR_HIGHLEVEL_CODE
void sys_init_type_info_module(void); /* suppress gcc -Wmissing-decl warning */
@@ -433,34 +440,304 @@
#endif /* ! MR_HIGHLEVEL_CODE */
").
+
+
+:- pragma foreign_code("MC++", "
+
+static MR_TypeInfo MR_typeclass_info_type_info(
+ MR_TypeClassInfo tcinfo, int index)
+{
+ MR_Runtime::SORRY(""foreign code for this function"");
+ return 0;
+}
+static MR_TypeInfo MR_typeclass_info_unconstrained_type_info(
+ MR_TypeClassInfo tcinfo, int index)
+{
+ MR_Runtime::SORRY(""foreign code for this function"");
+ return 0;
+}
+
+static MR_TypeClassInfo MR_typeclass_info_superclass_info(
+ MR_TypeClassInfo tcinfo, int index)
+{
+ MR_Runtime::SORRY(""foreign code for this function"");
+ return 0;
+}
+
+static MR_TypeClassInfo MR_typeclass_info_arg_typeclass_info(
+ MR_TypeClassInfo tcinfo, int index)
+{
+ MR_Runtime::SORRY(""foreign code for this function"");
+ return 0;
+}
+
+").
+
+:- pragma foreign_code("MC++", "
+
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, type_ctor_info, 1,
+ MR_TYPECTOR_REP_TYPEINFO)
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, type_info, 1,
+ MR_TYPECTOR_REP_TYPEINFO)
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, base_typeclass_info, 1,
+ MR_TYPECTOR_REP_TYPECLASSINFO)
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, typeclass_info, 1,
+ MR_TYPECTOR_REP_TYPECLASSINFO)
+
+ // XXX These static constants are duplicated both here and in
+ // mercury_cpp.cpp.
+ // This is because other library modules reference them
+ // from MC++ code (so they depend on the versions in the runtime to
+ // make the dependencies simple) whereas the compiler generates
+ // references to the ones here.
+
+ static int MR_TYPECTOR_REP_ENUM = MR_TYPECTOR_REP_ENUM_val;
+ static int MR_TYPECTOR_REP_ENUM_USEREQ = MR_TYPECTOR_REP_ENUM_USEREQ_val;
+ static int MR_TYPECTOR_REP_DU = MR_TYPECTOR_REP_DU_val;
+ static int MR_TYPECTOR_REP_DU_USEREQ = 3;
+ static int MR_TYPECTOR_REP_NOTAG = 4;
+ static int MR_TYPECTOR_REP_NOTAG_USEREQ = 5;
+ static int MR_TYPECTOR_REP_EQUIV = 6;
+ static int MR_TYPECTOR_REP_EQUIV_VAR = 7;
+ static int MR_TYPECTOR_REP_INT = 8;
+ static int MR_TYPECTOR_REP_CHAR = 9;
+ static int MR_TYPECTOR_REP_FLOAT =10;
+ static int MR_TYPECTOR_REP_STRING =11;
+ static int MR_TYPECTOR_REP_PRED =12;
+ static int MR_TYPECTOR_REP_UNIV =13;
+ static int MR_TYPECTOR_REP_VOID =14;
+ static int MR_TYPECTOR_REP_C_POINTER =15;
+ static int MR_TYPECTOR_REP_TYPEINFO =16;
+ static int MR_TYPECTOR_REP_TYPECLASSINFO =17;
+ static int MR_TYPECTOR_REP_ARRAY =18;
+ static int MR_TYPECTOR_REP_SUCCIP =19;
+ static int MR_TYPECTOR_REP_HP =20;
+ static int MR_TYPECTOR_REP_CURFR =21;
+ static int MR_TYPECTOR_REP_MAXFR =22;
+ static int MR_TYPECTOR_REP_REDOFR =23;
+ static int MR_TYPECTOR_REP_REDOIP =24;
+ static int MR_TYPECTOR_REP_TRAIL_PTR =25;
+ static int MR_TYPECTOR_REP_TICKET =26;
+ static int MR_TYPECTOR_REP_NOTAG_GROUND =27;
+ static int MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ =28;
+ static int MR_TYPECTOR_REP_EQUIV_GROUND =29;
+
+ static int MR_SECTAG_NONE = 0;
+ static int MR_SECTAG_LOCAL = 1;
+ static int MR_SECTAG_REMOTE = 2;
+
+
+ static int
+ mercury__private_builtin____Unify____type_info_1_0(
+ MR_Word type_info, MR_Word x, MR_Word y)
+ {
+ MR_Runtime::SORRY(""unify for type_info"");
+ return 0;
+ }
+
+ static int
+ mercury__private_builtin____Unify____typeclass_info_1_0(
+ MR_Word type_info, MR_Word x, MR_Word y)
+ {
+ MR_Runtime::SORRY(""unify for typeclass_info"");
+ return 0;
+ }
+
+ static int
+ mercury__private_builtin____Unify____base_typeclass_info_1_0(
+ MR_Word type_info, MR_Word x, MR_Word y)
+ {
+ MR_Runtime::SORRY(""unify for base_typeclass_info"");
+ return 0;
+ }
+
+ static int
+ mercury__private_builtin____Unify____type_ctor_info_1_0(
+ MR_Word type_info, MR_Word x, MR_Word y)
+ {
+ MR_Runtime::SORRY(""unify for type_ctor_info"");
+ return 0;
+ }
+
+ static void
+ mercury__private_builtin____Compare____type_ctor_info_1_0(
+ MR_Word type_info, MR_Word_Ref result, MR_Word x, MR_Word y)
+ {
+ MR_Runtime::SORRY(""compare for type_ctor_info"");
+ }
+
+ static void
+ mercury__private_builtin____Compare____type_info_1_0(
+ MR_Word type_info, MR_Word_Ref result, MR_Word x, MR_Word y)
+ {
+ MR_Runtime::SORRY(""compare for type_info"");
+ }
+
+ static void
+ mercury__private_builtin____Compare____typeclass_info_1_0(
+ MR_Word type_info, MR_Word_Ref result, MR_Word x, MR_Word y)
+ {
+ MR_Runtime::SORRY(""compare for typeclass_info"");
+ }
+
+ static void
+ mercury__private_builtin____Compare____base_typeclass_info_1_0(
+ MR_Word type_info, MR_Word_Ref result, MR_Word x, MR_Word y)
+ {
+ MR_Runtime::SORRY(""compare for base_typeclass_info"");
+ }
+
+ static int
+ mercury__private_builtin__do_unify__type_ctor_info_1_0(
+ MR_Word type_info, MR_Box x, MR_Box y)
+ {
+ return mercury__private_builtin____Unify____type_ctor_info_1_0(
+ type_info,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+ }
+
+ static int
+ mercury__private_builtin__do_unify__type_info_1_0(
+ MR_Word type_info, MR_Box x, MR_Box y)
+ {
+ return mercury__private_builtin____Unify____type_info_1_0(
+ type_info,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+ }
+
+ static int
+ mercury__private_builtin__do_unify__typeclass_info_1_0(
+ MR_Word type_info, MR_Box x, MR_Box y)
+ {
+ return mercury__private_builtin____Unify____typeclass_info_1_0(
+ type_info,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+ }
+
+ static int
+ mercury__private_builtin__do_unify__base_typeclass_info_1_0(
+ MR_Word type_info, MR_Box x, MR_Box y)
+ {
+ return mercury__private_builtin____Unify____base_typeclass_info_1_0(
+ type_info,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+ }
+
+ static void
+ mercury__private_builtin__do_compare__type_ctor_info_1_0(
+ MR_Word type_info, MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ mercury__private_builtin____Compare____type_ctor_info_1_0(
+ type_info, result,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+ }
+
+ static void
+ mercury__private_builtin__do_compare__type_info_1_0(
+ MR_Word type_info, MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ mercury__private_builtin____Compare____type_info_1_0(
+ type_info, result,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+ }
+
+ static void
+ mercury__private_builtin__do_compare__typeclass_info_1_0(
+ MR_Word type_info, MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ mercury__private_builtin____Compare____typeclass_info_1_0(
+ type_info, result,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+ }
+
+ static void
+ mercury__private_builtin__do_compare__base_typeclass_info_1_0(
+ MR_Word type_info, MR_Word_Ref result, MR_Box x, MR_Box y)
+ {
+ mercury__private_builtin____Compare____base_typeclass_info_1_0(
+ type_info, result,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+ }
+
+ static void init_runtime(void)
+ {
+ mercury::init::init_runtime();
+ }
+").
+
+:- pragma foreign_code("C",
+ type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
+ TypeInfo::out), [will_not_call_mercury, thread_safe],
+"
+ TypeInfo = MR_typeclass_info_type_info(TypeClassInfo, Index);
+").
+
+:- pragma foreign_code("C",
+ unconstrained_type_info_from_typeclass_info(TypeClassInfo::in,
+ Index::in, TypeInfo::out), [will_not_call_mercury, thread_safe],
+"
+ TypeInfo = MR_typeclass_info_unconstrained_type_info(TypeClassInfo,
+ Index);
+").
+
+:- pragma foreign_code("C",
+ superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
+ TypeClassInfo::out), [will_not_call_mercury, thread_safe],
+"
+ TypeClassInfo =
+ MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
+").
-:- pragma c_code(type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
- TypeInfo::out), [will_not_call_mercury, thread_safe],
+:- pragma foreign_code("C",
+ instance_constraint_from_typeclass_info(TypeClassInfo0::in,
+ Index::in, TypeClassInfo::out),
+ [will_not_call_mercury, thread_safe],
"
+ TypeClassInfo =
+ MR_typeclass_info_arg_typeclass_info(TypeClassInfo0, Index);
+").
+
+:- pragma foreign_code("MC++",
+ type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
+ TypeInfo::out), [will_not_call_mercury, thread_safe],
+"
TypeInfo = MR_typeclass_info_type_info(TypeClassInfo, Index);
").
-:- pragma c_code(unconstrained_type_info_from_typeclass_info(TypeClassInfo::in,
- Index::in, TypeInfo::out), [will_not_call_mercury, thread_safe],
+:- pragma foreign_code("MC++",
+ unconstrained_type_info_from_typeclass_info(TypeClassInfo::in,
+ Index::in, TypeInfo::out), [will_not_call_mercury, thread_safe],
"
TypeInfo = MR_typeclass_info_unconstrained_type_info(TypeClassInfo,
Index);
").
-:- pragma c_code(superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
- TypeClassInfo::out), [will_not_call_mercury, thread_safe],
+:- pragma foreign_code("MC++",
+ superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
+ TypeClassInfo::out), [will_not_call_mercury, thread_safe],
"
TypeClassInfo =
MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
").
-:- pragma c_code(instance_constraint_from_typeclass_info(TypeClassInfo0::in,
- Index::in, TypeClassInfo::out), [will_not_call_mercury, thread_safe],
+:- pragma foreign_code("MC++",
+ instance_constraint_from_typeclass_info(TypeClassInfo0::in,
+ Index::in, TypeClassInfo::out),
+ [will_not_call_mercury, thread_safe],
"
TypeClassInfo =
MR_typeclass_info_arg_typeclass_info(TypeClassInfo0, Index);
").
+
%-----------------------------------------------------------------------------%
:- interface.
@@ -490,6 +767,16 @@
% the following is never executed
true
).
+
+/*
+
+XXX :- external stops us from using this
+
+:- pragma foreign_code("MC++", free_heap(_A::di),
+ [will_not_call_mercury], "
+ MR_Runtime::SORRY(""foreign code for this predicate"");
+").
+*/
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/sparse_bitset.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/sparse_bitset.m,v
retrieving revision 1.3
diff -u -r1.3 sparse_bitset.m
--- library/sparse_bitset.m 2000/11/28 05:52:00 1.3
+++ library/sparse_bitset.m 2000/12/03 07:12:51
@@ -764,13 +764,21 @@
% to avoid unnecessary memory retention.
% Doing this slows down the compiler by about 1%,
% but in a library module it's better to be safe.
-:- pragma c_code(make_bitset_elem(A::in, B::in) = (Pair::out),
+:- pragma foreign_code("C", make_bitset_elem(A::in, B::in) = (Pair::out),
[will_not_call_mercury, thread_safe],
"{
MR_incr_hp_atomic_msg(Pair, 2, MR_PROC_LABEL,
""sparse_bitset:bitset_elem/0"");
MR_field(MR_mktag(0), Pair, 0) = A;
MR_field(MR_mktag(0), Pair, 1) = B;
+}").
+
+:- pragma foreign_code("MC++", make_bitset_elem(A::in, B::in) = (Pair::out),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_newobj((Pair), 0, 2);
+ MR_objset((Pair), 1, (mr_convert::ToObject(A)));
+ MR_objset((Pair), 2, (mr_convert::ToObject(B)));
}").
%-----------------------------------------------------------------------------%
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.207
diff -u -r1.207 std_util.m
--- library/std_util.m 2000/11/24 06:02:10 1.207
+++ library/std_util.m 2000/12/01 03:37:26
@@ -91,7 +91,8 @@
% The "unit" type - stores no information at all.
-:- type unit ---> unit.
+ % XXX I get a warning for this one too
+:- type unit ---> unit ; aaa.
%-----------------------------------------------------------------------------%
@@ -793,7 +794,8 @@
%
:- impure pred get_registers(heap_ptr::out, heap_ptr::out, trail_ptr::out)
is det.
-:- pragma c_code(get_registers(HeapPtr::out, SolutionsHeapPtr::out,
+:- pragma foreign_code("C",
+ get_registers(HeapPtr::out, SolutionsHeapPtr::out,
TrailPtr::out), will_not_call_mercury,
"
/* save heap states */
@@ -812,31 +814,52 @@
#endif
").
+:- pragma foreign_code("MC++",
+ get_registers(_HeapPtr::out, _SolutionsHeapPtr::out,
+ _TrailPtr::out), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+
:- impure pred check_for_floundering(trail_ptr::in) is det.
-:- pragma c_code(check_for_floundering(TrailPtr::in), [will_not_call_mercury],
+:- pragma foreign_code("C",
+ check_for_floundering(TrailPtr::in), [will_not_call_mercury],
"
#ifdef MR_USE_TRAIL
/* check for outstanding delayed goals (``floundering'') */
MR_reset_ticket(TrailPtr, MR_solve);
#endif
").
+:- pragma foreign_code("MC++",
+ check_for_floundering(_TrailPtr::in), [will_not_call_mercury],
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
%
% Discard the topmost trail ticket.
%
:- impure pred discard_trail_ticket is det.
-:- pragma c_code(discard_trail_ticket, [will_not_call_mercury],
+:- pragma foreign_code("C",
+ discard_trail_ticket, [will_not_call_mercury],
"
#ifdef MR_USE_TRAIL
MR_discard_ticket();
#endif
").
+:- pragma foreign_code("MC++",
+ discard_trail_ticket, [will_not_call_mercury],
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
%
% Swap the heap with the solutions heap
%
:- impure pred swap_heap_and_solutions_heap is det.
-:- pragma c_code(swap_heap_and_solutions_heap,
+:- pragma foreign_code("C",
+ swap_heap_and_solutions_heap,
will_not_call_mercury,
"
#ifndef CONSERVATIVE_GC
@@ -853,6 +876,12 @@
}
#endif
").
+:- pragma foreign_code("MC++",
+ swap_heap_and_solutions_heap,
+ will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
%
% partial_deep_copy(SolutionsHeapPtr, OldVal, NewVal):
@@ -864,7 +893,7 @@
:- mode partial_deep_copy(in, mdi, muo) is det.
:- mode partial_deep_copy(in, in, out) is det.
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include ""mercury_deep_copy.h""
@@ -893,22 +922,42 @@
").
-:- pragma c_code(partial_deep_copy(SolutionsHeapPtr::in,
- OldVal::in, NewVal::out), will_not_call_mercury,
+:- pragma foreign_code("C",
+ partial_deep_copy(SolutionsHeapPtr::in,
+ OldVal::in, NewVal::out), will_not_call_mercury,
"
MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, OldVal, NewVal, TypeInfo_for_T);
").
-:- pragma c_code(partial_deep_copy(SolutionsHeapPtr::in,
- OldVal::mdi, NewVal::muo), will_not_call_mercury,
+:- pragma foreign_code("C",
+ partial_deep_copy(SolutionsHeapPtr::in,
+ OldVal::mdi, NewVal::muo), will_not_call_mercury,
"
MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, OldVal, NewVal, TypeInfo_for_T);
").
-:- pragma c_code(partial_deep_copy(SolutionsHeapPtr::in,
- OldVal::di, NewVal::uo), will_not_call_mercury,
+:- pragma foreign_code("C", partial_deep_copy(SolutionsHeapPtr::in,
+ OldVal::di, NewVal::uo), will_not_call_mercury,
"
MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, OldVal, NewVal, TypeInfo_for_T);
").
+:- pragma foreign_code("MC++",
+ partial_deep_copy(_SolutionsHeapPtr::in,
+ _OldVal::in, _NewVal::out), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+:- pragma foreign_code("MC++",
+ partial_deep_copy(_SolutionsHeapPtr::in,
+ _OldVal::mdi, _NewVal::muo), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+:- pragma foreign_code("MC++", partial_deep_copy(_SolutionsHeapPtr::in,
+ _OldVal::di, _NewVal::uo), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
%
% reset_solutions_heap(SolutionsHeapPtr):
% Reset the solutions heap pointer to the specified value,
@@ -916,7 +965,8 @@
% heap since that value was obtained via get_registers/3.
%
:- impure pred reset_solutions_heap(heap_ptr::in) is det.
-:- pragma c_code(reset_solutions_heap(SolutionsHeapPtr::in),
+:- pragma foreign_code("C",
+ reset_solutions_heap(SolutionsHeapPtr::in),
will_not_call_mercury,
"
#ifndef CONSERVATIVE_GC
@@ -924,6 +974,13 @@
#endif
").
+:- pragma foreign_code("MC++",
+ reset_solutions_heap(_SolutionsHeapPtr::in),
+ will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
%-----------------------------------------------------------------------------%
%%% :- module mutvar.
@@ -960,28 +1017,54 @@
:- type mutvar(T) ---> mutvar(c_pointer).
:- pragma inline(new_mutvar/2).
-:- pragma c_code(new_mutvar(X::in, Ref::out), will_not_call_mercury,
+:- pragma foreign_code("C", new_mutvar(X::in, Ref::out), will_not_call_mercury,
"
MR_incr_hp_msg(Ref, 1, MR_PROC_LABEL, ""std_util:mutvar/1"");
*(MR_Word *) Ref = X;
").
-:- pragma c_code(new_mutvar(X::di, Ref::uo), will_not_call_mercury,
+:- pragma foreign_code("C", new_mutvar(X::di, Ref::uo), will_not_call_mercury,
"
MR_incr_hp_msg(Ref, 1, MR_PROC_LABEL, ""std_util:mutvar/1"");
*(MR_Word *) Ref = X;
").
:- pragma inline(get_mutvar/2).
-:- pragma c_code(get_mutvar(Ref::in, X::uo), will_not_call_mercury,
+:- pragma foreign_code("C", get_mutvar(Ref::in, X::uo), will_not_call_mercury,
"
X = *(MR_Word *) Ref;
").
:- pragma inline(set_mutvar/2).
-:- pragma c_code(set_mutvar(Ref::in, X::in), will_not_call_mercury, "
+:- pragma foreign_code("C", set_mutvar(Ref::in, X::in), will_not_call_mercury, "
*(MR_Word *) Ref = X;
").
+:- pragma foreign_code("MC++",
+ new_mutvar(_X::in, _Ref::out), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+:- pragma foreign_code("MC++",
+ new_mutvar(_X::di, _Ref::uo), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma inline(get_mutvar/2).
+:- pragma foreign_code("MC++",
+ get_mutvar(_Ref::in, _X::uo), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma inline(set_mutvar/2).
+:- pragma foreign_code("MC++",
+ set_mutvar(_Ref::in, _X::in), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+
%%% end_module mutvar.
%-----------------------------------------------------------------------------%
@@ -1029,18 +1112,33 @@
% semidet_succeed and semidet_fail, implemented using the C interface
% to make sure that the compiler doesn't issue any determinism warnings
% for them.
+
+:- pragma foreign_code("C", semidet_succeed,
+ [will_not_call_mercury, thread_safe],
+ "SUCCESS_INDICATOR = TRUE;").
+:- pragma foreign_code("C", semidet_fail, [will_not_call_mercury, thread_safe],
+ "SUCCESS_INDICATOR = FALSE;").
+:- pragma foreign_code("C", cc_multi_equal(X::in, Y::out),
+ [will_not_call_mercury, thread_safe],
+ "Y = X;").
+:- pragma foreign_code("C", cc_multi_equal(X::di, Y::uo),
+ [will_not_call_mercury, thread_safe],
+ "Y = X;").
-:- pragma c_code(semidet_succeed, [will_not_call_mercury, thread_safe],
+:- pragma foreign_code("MC++", semidet_succeed,
+ [will_not_call_mercury, thread_safe],
"SUCCESS_INDICATOR = TRUE;").
-:- pragma c_code(semidet_fail, [will_not_call_mercury, thread_safe],
+:- pragma foreign_code("MC++", semidet_fail,
+ [will_not_call_mercury, thread_safe],
"SUCCESS_INDICATOR = FALSE;").
-:- pragma c_code(cc_multi_equal(X::in, Y::out),
+:- pragma foreign_code("MC++", cc_multi_equal(X::in, Y::out),
[will_not_call_mercury, thread_safe],
"Y = X;").
-:- pragma c_code(cc_multi_equal(X::di, Y::uo),
+:- pragma foreign_code("MC++", cc_multi_equal(X::di, Y::uo),
[will_not_call_mercury, thread_safe],
"Y = X;").
+
%-----------------------------------------------------------------------------%
% The type `std_util:type_desc/0' happens to use much the same
@@ -1062,14 +1160,21 @@
error(ErrorString)
).
-:- pragma c_code(univ_value(Univ::in) = (Value::out), will_not_call_mercury, "
+:- pragma foreign_code("C", univ_value(Univ::in) = (Value::out), will_not_call_mercury, "
MR_TypeInfo typeinfo;
MR_unravel_univ(Univ, typeinfo, Value);
TypeInfo_for_T = (MR_Word) typeinfo;
").
-:- pragma c_header_code("
+:- pragma foreign_code("MC++",
+ univ_value(_Univ::in) = (_Value::out), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+
+:- pragma foreign_decl("C", "
/*
** `univ' is represented as a two word structure.
** One word contains the address of a type_info for the type.
@@ -1094,20 +1199,26 @@
% Allocate heap space, set the first field to contain the address
% of the type_info for this type, and then store the input argument
% in the second field.
-:- pragma c_code(type_to_univ(Value::di, Univ::uo), will_not_call_mercury, "
- MR_incr_hp_msg(Univ, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(Univ, TypeInfo_for_T, Value);
-").
-:- pragma c_code(type_to_univ(Value::in, Univ::out), will_not_call_mercury, "
- MR_incr_hp_msg(Univ, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(Univ, TypeInfo_for_T, Value);
+:- pragma foreign_code("C",
+ type_to_univ(Value::di, Univ::uo), will_not_call_mercury,
+"
+ MR_incr_hp_msg(Univ, 2, MR_PROC_LABEL, ""std_util:univ/0"");
+ MR_define_univ_fields(Univ, TypeInfo_for_T, Value);
").
+:- pragma foreign_code("C",
+ type_to_univ(Value::in, Univ::out), will_not_call_mercury,
+"
+ MR_incr_hp_msg(Univ, 2, MR_PROC_LABEL, ""std_util:univ/0"");
+ MR_define_univ_fields(Univ, TypeInfo_for_T, Value);
+").
% Backward mode - convert from univ to type.
% We check that type_infos compare equal.
% The variable `TypeInfo_for_T' used in the C code
% is the compiler-introduced type-info variable.
-:- pragma c_code(type_to_univ(Value::out, Univ::in), will_not_call_mercury, "{
+:- pragma foreign_code("C",
+ type_to_univ(Value::out, Univ::in), will_not_call_mercury,
+"{
MR_Word univ_type_info;
int comp;
@@ -1124,12 +1235,54 @@
}
}").
-:- pragma c_code(univ_type(Univ::in) = (TypeInfo::out), will_not_call_mercury, "
+:- pragma foreign_code("C", univ_type(Univ::in) = (TypeInfo::out),
+ will_not_call_mercury,
+"
TypeInfo = MR_field(MR_mktag(0), Univ, UNIV_OFFSET_FOR_TYPEINFO);
").
-:- pragma c_code("
+:- pragma foreign_code("MC++",
+ type_to_univ(Value::di, Univ::uo), will_not_call_mercury,
+"
+ MR_untagged_newobj(Univ, 2);
+ MR_objset(Univ, 0, TypeInfo_for_T);
+ MR_objset(Univ, 1, Value);
+").
+:- pragma foreign_code("MC++",
+ type_to_univ(Value::in, Univ::out), will_not_call_mercury,
+"
+ MR_untagged_newobj(Univ, 2);
+ MR_objset(Univ, 0, TypeInfo_for_T);
+ MR_objset(Univ, 1, Value);
+").
+
+ % Backward mode - convert from univ to type.
+ % We check that type_infos compare equal.
+ % The variable `TypeInfo_for_T' used in the C code
+ % is the compiler-introduced type-info variable.
+:- pragma foreign_code("MC++",
+ type_to_univ(Value::out, Univ::in), will_not_call_mercury,
+"{
+ MR_Word univ_type_info = Value->GetValue(0);
+ if (MR_compare_type_info(TypeInfo_for_T, univ_type_info)
+ == MR_COMPARE_EQUAL) {
+ MR_Box UnivValue = Univ->GetValue(1);
+ Value = UnivValue;
+ SUCCESS_INDICATOR = TRUE;
+ } else {
+ SUCCESS_INDICATOR = FALSE;
+ }
+}").
+
+:- pragma foreign_code("MC++", univ_type(Univ::in) = (TypeInfo::out),
+ will_not_call_mercury,
+"
+ TypeInfo = Univ->GetValue(0);
+").
+
+:- pragma foreign_code("C", "
+
#ifdef MR_HIGHLEVEL_CODE
void sys_init_unify_univ_module(void); /* suppress gcc -Wmissing-decl warning */
void sys_init_unify_univ_module(void) { return; }
@@ -1295,13 +1448,90 @@
").
+:- pragma foreign_code("MC++", "
+
+MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(std_util, univ, 0, MR_TYPECTOR_REP_UNIV)
+MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(std_util, type_desc, 0,
+ MR_TYPECTOR_REP_C_POINTER)
+
+static int MR_compare_type_info(MR_TypeInfo x, MR_TypeInfo y) {
+ MR_Runtime::SORRY(""foreign code for this function"");
+ return 0;
+}
+
+static int
+mercury__std_util____Unify____univ_0_0(MR_Word x, MR_Word y)
+{
+ MR_Runtime::SORRY(""unify for univ"");
+ return 0;
+}
+
+static int
+mercury__std_util____Unify____type_desc_0_0(MR_Word x, MR_Word y)
+{
+ MR_Runtime::SORRY(""unify for type_desc"");
+ return 0;
+}
+
+static void
+mercury__std_util____Compare____univ_0_0(MR_Word_Ref result,
+MR_Word x, MR_Word y)
+{
+ MR_Runtime::SORRY(""compare for univ"");
+}
+
+static void
+mercury__std_util____Compare____type_desc_0_0(
+ MR_Word_Ref result, MR_Word x, MR_Word y)
+{
+ MR_Runtime::SORRY(""compare for type_desc"");
+}
+
+static int
+mercury__std_util__do_unify__univ_0_0(MR_Box x, MR_Box y)
+{
+ return mercury__std_util____Unify____univ_0_0(
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+}
+
+static int
+mercury__std_util__do_unify__type_desc_0_0(MR_Box x, MR_Box y)
+{
+ return mercury__std_util____Unify____type_desc_0_0(
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+}
+
+static void
+mercury__std_util__do_compare__univ_0_0(MR_Word_Ref result,
+ MR_Box x, MR_Box y)
+{
+ mercury__std_util____Compare____univ_0_0(
+ result,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+}
+
+static void
+mercury__std_util__do_compare__type_desc_0_0(
+ MR_Word_Ref result, MR_Box x, MR_Box y)
+{
+ mercury__std_util____Compare____type_desc_0_0(
+ result,
+ dynamic_cast<MR_Word>(x),
+ dynamic_cast<MR_Word>(y));
+}
+
+").
+
%-----------------------------------------------------------------------------%
% Code for type manipulation.
% Prototypes and type definitions.
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
/* The `#ifndef ... #define ... #endif' guards against multiple inclusion */
#ifndef ML_TYPECTORDESC_GUARD
@@ -1408,7 +1638,7 @@
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
/* The `#ifndef ... #define ... #endif' guards against multiple inclusion */
#ifndef ML_CONSTRUCT_INFO_GUARD
@@ -1455,7 +1685,7 @@
% detail.
:- type type_ctor_desc == type_desc.
-:- pragma c_code(type_of(_Value::unused) = (TypeInfo::out),
+:- pragma foreign_code("C", type_of(_Value::unused) = (TypeInfo::out),
will_not_call_mercury, "
{
TypeInfo = TypeInfo_for_T;
@@ -1475,8 +1705,22 @@
}
").
+
+:- pragma foreign_code("MC++", type_of(_Value::unused) = (TypeInfo::out),
+ will_not_call_mercury, "
+{
+ TypeInfo = TypeInfo_for_T;
+}
+").
-:- pragma c_code(has_type(_Arg::unused, TypeInfo::in), will_not_call_mercury, "
+
+:- pragma foreign_code("C",
+ has_type(_Arg::unused, TypeInfo::in), will_not_call_mercury, "
+ TypeInfo_for_T = TypeInfo;
+").
+
+:- pragma foreign_code("MC++",
+ has_type(_Arg::unused, TypeInfo::in), will_not_call_mercury, "
TypeInfo_for_T = TypeInfo;
").
@@ -1557,7 +1801,7 @@
error("det_make_type/2: make_type/2 failed (wrong arity)")
).
-:- pragma c_code(type_ctor(TypeInfo::in) = (TypeCtor::out),
+:- pragma foreign_code("C", type_ctor(TypeInfo::in) = (TypeCtor::out),
will_not_call_mercury, "
{
MR_TypeCtorInfo type_ctor_info;
@@ -1572,15 +1816,23 @@
TypeCtor = (MR_Word) ML_make_type_ctor_desc(type_info, type_ctor_info);
}
").
+
+:- pragma foreign_code("MC++", type_ctor(_TypeInfo::in) = (_TypeCtor::out),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""compare for type_desc"");
+}
+").
+
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
extern MR_TypeCtorDesc ML_make_type_ctor_desc(MR_TypeInfo type_info,
MR_TypeCtorInfo type_ctor_info);
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
MR_TypeCtorDesc
ML_make_type_ctor_desc(MR_TypeInfo type_info, MR_TypeCtorInfo type_ctor_info)
@@ -1650,7 +1902,7 @@
}
").
-:- pragma c_code(type_ctor_and_args(TypeDesc::in,
+:- pragma foreign_code("C", type_ctor_and_args(TypeDesc::in,
TypeCtorDesc::out, ArgTypes::out), will_not_call_mercury, "
{
MR_TypeCtorDesc type_ctor_desc;
@@ -1666,6 +1918,13 @@
}
").
+:- pragma foreign_code("MC++", type_ctor_and_args(_TypeDesc::in,
+ _TypeCtorDesc::out, _ArgTypes::out), will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""compare for type_desc"");
+}
+").
+
/*
** This is the forwards mode of make_type/2:
** given a type constructor and a list of argument
@@ -1675,7 +1934,8 @@
** a new type with the specified arguments.
*/
-:- pragma c_code(make_type(TypeCtorDesc::in, ArgTypes::in) = (TypeDesc::out),
+:- pragma foreign_code("C",
+ make_type(TypeCtorDesc::in, ArgTypes::in) = (TypeDesc::out),
will_not_call_mercury, "
{
MR_TypeCtorDesc type_ctor_desc;
@@ -1711,13 +1971,23 @@
}
").
+:- pragma foreign_code("MC++",
+ make_type(_TypeCtorDesc::in, _ArgTypes::in) = (_TypeDesc::out),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""compare for type_desc"");
+}
+").
+
+
/*
** This is the reverse mode of make_type: given a type,
** split it up into a type constructor and a list of
** arguments.
*/
-:- pragma c_code(make_type(TypeCtorDesc::out, ArgTypes::out) = (TypeDesc::in),
+:- pragma foreign_code("C",
+ make_type(TypeCtorDesc::out, ArgTypes::out) = (TypeDesc::in),
will_not_call_mercury, "
{
MR_TypeCtorDesc type_ctor_desc;
@@ -1733,7 +2003,7 @@
}
").
-:- pragma c_code(type_ctor_name_and_arity(TypeCtorDesc::in,
+:- pragma foreign_code("C", type_ctor_name_and_arity(TypeCtorDesc::in,
TypeCtorModuleName::out, TypeCtorName::out, TypeCtorArity::out),
will_not_call_mercury, "
{
@@ -1767,7 +2037,7 @@
}
").
-:- pragma c_code(num_functors(TypeInfo::in) = (Functors::out),
+:- pragma foreign_code("C", num_functors(TypeInfo::in) = (Functors::out),
will_not_call_mercury, "
{
MR_save_transient_registers();
@@ -1776,7 +2046,7 @@
}
").
-:- pragma c_code(get_functor(TypeDesc::in, FunctorNumber::in,
+:- pragma foreign_code("C", get_functor(TypeDesc::in, FunctorNumber::in,
FunctorName::out, Arity::out, TypeInfoList::out),
will_not_call_mercury, "
{
@@ -1829,8 +2099,9 @@
}
").
-:- pragma c_code(get_functor_ordinal(TypeDesc::in, FunctorNumber::in,
- Ordinal::out), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ get_functor_ordinal(TypeDesc::in, FunctorNumber::in,
+ Ordinal::out), will_not_call_mercury, "
{
MR_TypeInfo type_info;
ML_Construct_Info construct_info;
@@ -1881,8 +2152,9 @@
}
").
-:- pragma c_code(construct(TypeDesc::in, FunctorNumber::in, ArgList::in) =
- (Term::out), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ construct(TypeDesc::in, FunctorNumber::in, ArgList::in) = (Term::out),
+ will_not_call_mercury, "
{
MR_TypeInfo type_info;
MR_TypeCtorInfo type_ctor_info;
@@ -2046,6 +2318,54 @@
}
").
+:- pragma foreign_code("MC++",
+ make_type(_TypeCtorDesc::out, _ArgTypes::out) = (_TypeDesc::in),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""compare for type_desc"");
+}
+").
+
+:- pragma foreign_code("MC++", type_ctor_name_and_arity(_TypeCtorDesc::in,
+ _TypeCtorModuleName::out, _TypeCtorName::out,
+ _TypeCtorArity::out),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""compare for type_desc"");
+}
+").
+
+:- pragma foreign_code("MC++", num_functors(_TypeInfo::in) = (_Functors::out),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""compare for type_desc"");
+}
+").
+
+:- pragma foreign_code("MC++", get_functor(_TypeDesc::in, _FunctorNumber::in,
+ _FunctorName::out, _Arity::out, _TypeInfoList::out),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""compare for type_desc"");
+}
+").
+
+:- pragma foreign_code("MC++",
+ get_functor_ordinal(_TypeDesc::in, _FunctorNumber::in,
+ _Ordinal::out), will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""compare for type_desc"");
+}
+").
+
+:- pragma foreign_code("MC++",
+ construct(_TypeDesc::in, _FunctorNumber::in,
+ _ArgList::in) = (_Term::out), will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""compare for type_desc"");
+}
+").
+
construct_tuple(Args) =
construct_tuple_2(Args,
list__map(univ_type, Args),
@@ -2053,8 +2373,8 @@
:- func construct_tuple_2(list(univ), list(type_desc), int) = univ.
-:- pragma c_code(construct_tuple_2(Args::in, ArgTypes::in,
- Arity::in) = (Term::out),
+:- pragma foreign_code("C",
+ construct_tuple_2(Args::in, ArgTypes::in, Arity::in) = (Term::out),
will_not_call_mercury, "
{
MR_TypeInfo type_info;
@@ -2094,8 +2414,17 @@
}
").
-:- pragma c_code("
+:- pragma foreign_code("MC++",
+ construct_tuple_2(_Args::in, _ArgTypes::in, _Arity::in) = (_Term::out),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""compare for type_desc"");
+}
+").
+
+:- pragma foreign_code("C", "
+
/*
** Prototypes
*/
@@ -2567,7 +2896,7 @@
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include <stdio.h>
@@ -2629,7 +2958,7 @@
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
/*
** Expand the given data using its type_info, find its
@@ -3165,7 +3494,7 @@
% Code for functor, arg and deconstruct.
-:- pragma c_code(functor(Term::in, Functor::out, Arity::out),
+:- pragma foreign_code("C", functor(Term::in, Functor::out, Arity::out),
will_not_call_mercury, "
{
MR_TypeInfo type_info;
@@ -3205,7 +3534,7 @@
** changes to store__arg_ref in store.m.
*/
-:- pragma c_code(arg(Term::in, ArgumentIndex::in) = (Argument::out),
+:- pragma foreign_code("C", arg(Term::in, ArgumentIndex::in) = (Argument::out),
will_not_call_mercury, "
{
MR_TypeInfo type_info;
@@ -3237,7 +3566,8 @@
SUCCESS_INDICATOR = success;
}").
-:- pragma c_code(argument(Term::in, ArgumentIndex::in) = (ArgumentUniv::out),
+:- pragma foreign_code("C",
+ argument(Term::in, ArgumentIndex::in) = (ArgumentUniv::out),
will_not_call_mercury, "
{
MR_TypeInfo type_info;
@@ -3261,6 +3591,31 @@
SUCCESS_INDICATOR = success;
}").
+:- pragma foreign_code("MC++", functor(_Term::in, _Functor::out, _Arity::out),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+/*
+** N.B. any modifications to arg/2 might also require similar
+** changes to store__arg_ref in store.m.
+*/
+
+:- pragma foreign_code("MC++",
+ arg(_Term::in, _ArgumentIndex::in) = (_Argument::out),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+:- pragma foreign_code("MC++",
+ argument(_Term::in, _ArgumentIndex::in) = (_ArgumentUniv::out),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
det_arg(Type, ArgumentIndex) = Argument :-
(
arg(Type, ArgumentIndex) = Argument0
@@ -3283,7 +3638,8 @@
error("det_argument: argument out of range")
).
-:- pragma c_code(deconstruct(Term::in, Functor::out, Arity::out,
+:- pragma foreign_code("C",
+ deconstruct(Term::in, Functor::out, Arity::out,
Arguments::out), will_not_call_mercury, "
{
ML_Expand_Info expand_info;
@@ -3346,6 +3702,14 @@
}
}").
+:- pragma foreign_code("MC++",
+ deconstruct(_Term::in, _Functor::out, _Arity::out,
+ _Arguments::out), will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}
+").
+
get_functor_info(Univ, FunctorInfo) :-
( univ_to_type(Univ, Int) ->
FunctorInfo = functor_integer(Int)
@@ -3376,8 +3740,9 @@
% with the type of the single function symbol of the notag type.
:- pred get_notag_functor_info(Univ::in, ExpUniv::out) is semidet.
-:- pragma c_code(get_notag_functor_info(Univ::in, ExpUniv::out),
- will_not_call_mercury, "
+:- pragma foreign_code("C",
+ get_notag_functor_info(Univ::in, ExpUniv::out),
+ will_not_call_mercury, "
{
MR_TypeInfo type_info;
MR_TypeInfo exp_type_info;
@@ -3415,13 +3780,21 @@
}
}").
+:- pragma foreign_code("MC++",
+ get_notag_functor_info(_Univ::in, _ExpUniv::out),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
% Given a value of an arbitrary type, succeed if its type is defined
% as an equivalence type, and return a univ which bundles up the value
% with the equivalent type. (I.e. this removes one layer of equivalence
% from the type stored in the univ.)
:- pred get_equiv_functor_info(Univ::in, ExpUniv::out) is semidet.
-:- pragma c_code(get_equiv_functor_info(Univ::in, ExpUniv::out),
+:- pragma foreign_code("C",
+ get_equiv_functor_info(Univ::in, ExpUniv::out),
will_not_call_mercury, "
{
MR_TypeInfo type_info;
@@ -3455,12 +3828,20 @@
}
}").
+:- pragma foreign_code("MC++",
+ get_equiv_functor_info(_Univ::in, _ExpUniv::out),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
% Given a value of an arbitrary type, succeed if it is an enum type,
% and return the integer value corresponding to the value.
:- pred get_enum_functor_info(Univ::in, Int::out) is semidet.
-:- pragma c_code(get_enum_functor_info(Univ::in, Enum::out),
- will_not_call_mercury, "
+:- pragma foreign_code("C",
+ get_enum_functor_info(Univ::in, Enum::out),
+ will_not_call_mercury, "
{
MR_TypeInfo type_info;
MR_TypeCtorInfo type_ctor_info;
@@ -3481,6 +3862,13 @@
}
}").
+:- pragma foreign_code("MC++",
+ get_enum_functor_info(_Univ::in, _Enum::out),
+ will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
% Given a value of an arbitrary type, succeed if it is a general du type
% (i.e. non-enum, non-notag du type), and return the top function symbol's
% arguments as well as its tag information: an indication of where the
@@ -3491,7 +3879,7 @@
:- pred get_du_functor_info(univ::in, int::out, int::out, int::out,
list(univ)::out) is semidet.
-:- pragma c_code(get_du_functor_info(Univ::in, Where::out,
+:- pragma foreign_code("C", get_du_functor_info(Univ::in, Where::out,
Ptag::out, Sectag::out, Args::out), will_not_call_mercury, "
{
MR_TypeInfo type_info;
@@ -3574,6 +3962,12 @@
SUCCESS_INDICATOR = FALSE;
break;
}
+}").
+
+:- pragma foreign_code("MC++", get_du_functor_info(_Univ::in, _Where::out,
+ _Ptag::out, _Sectag::out, _Args::out), will_not_call_mercury, "
+{
+ MR_Runtime::SORRY(""foreign code for this function"");
}").
%-----------------------------------------------------------------------------%
Index: library/store.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/store.m,v
retrieving revision 1.25
diff -u -r1.25 store.m
--- library/store.m 2000/11/23 02:00:15 1.25
+++ library/store.m 2000/12/01 03:34:05
@@ -208,7 +208,8 @@
:- implementation.
:- import_module std_util.
-:- type some_store_type ---> some_store_type.
+ % XXX aaargh yet again stupid broken compiler
+:- type some_store_type ---> some_store_type ; aaa.
:- type store(S) ---> store(c_pointer).
@@ -225,7 +226,7 @@
:- pred store__do_init(store(some_store_type)).
:- mode store__do_init(uo) is det.
-:- pragma c_code(store__do_init(_S0::uo), will_not_call_mercury, "").
+:- pragma foreign_code("C", store__do_init(_S0::uo), will_not_call_mercury, "").
/*
Note -- the syntax for the operations on stores
@@ -244,7 +245,7 @@
*/
-:- pragma c_code(new_mutvar(Val::in, Mutvar::out, S0::di, S::uo),
+:- pragma foreign_code("C", new_mutvar(Val::in, Mutvar::out, S0::di, S::uo),
will_not_call_mercury,
"
MR_incr_hp_msg(Mutvar, 1, MR_PROC_LABEL, ""store:mutvar/2"");
@@ -252,14 +253,14 @@
S = S0;
").
-:- pragma c_code(get_mutvar(Mutvar::in, Val::out, S0::di, S::uo),
+:- pragma foreign_code("C", get_mutvar(Mutvar::in, Val::out, S0::di, S::uo),
will_not_call_mercury,
"
Val = * (MR_Word *) Mutvar;
S = S0;
").
-:- pragma c_code(set_mutvar(Mutvar::in, Val::in, S0::di, S::uo),
+:- pragma foreign_code("C", set_mutvar(Mutvar::in, Val::in, S0::di, S::uo),
will_not_call_mercury,
"
* (MR_Word *) Mutvar = Val;
@@ -270,7 +271,7 @@
store(S), store(S)).
:- mode store__unsafe_new_uninitialized_mutvar(out, di, uo) is det.
-:- pragma c_code(unsafe_new_uninitialized_mutvar(Mutvar::out, S0::di, S::uo),
+:- pragma foreign_code("C", unsafe_new_uninitialized_mutvar(Mutvar::out, S0::di, S::uo),
will_not_call_mercury,
"
MR_incr_hp_msg(Mutvar, 1, MR_PROC_LABEL, ""store:mutvar/2"");
@@ -284,7 +285,7 @@
%-----------------------------------------------------------------------------%
-:- pragma c_code(new_ref(Val::di, Ref::out, S0::di, S::uo),
+:- pragma foreign_code("C", new_ref(Val::di, Ref::out, S0::di, S::uo),
will_not_call_mercury,
"
MR_incr_hp_msg(Ref, 1, MR_PROC_LABEL, ""store:ref/2"");
@@ -302,7 +303,7 @@
% value.
:- pred store__unsafe_ref_value(ref(T, S), T, store(S), store(S)).
:- mode store__unsafe_ref_value(in, uo, di, uo) is det.
-:- pragma c_code(unsafe_ref_value(Ref::in, Val::uo, S0::di, S::uo),
+:- pragma foreign_code("C", unsafe_ref_value(Ref::in, Val::uo, S0::di, S::uo),
will_not_call_mercury,
"
Val = * (MR_Word *) Ref;
@@ -324,7 +325,8 @@
").
-:- pragma c_code(arg_ref(Ref::in, ArgNum::in, ArgRef::out, S0::di, S::uo),
+:- pragma foreign_code("C",
+ arg_ref(Ref::in, ArgNum::in, ArgRef::out, S0::di, S::uo),
will_not_call_mercury,
"{
MR_TypeInfo type_info;
@@ -356,7 +358,8 @@
S = S0;
}").
-:- pragma c_code(new_arg_ref(Val::di, ArgNum::in, ArgRef::out, S0::di, S::uo),
+:- pragma foreign_code("C",
+ new_arg_ref(Val::di, ArgNum::in, ArgRef::out, S0::di, S::uo),
will_not_call_mercury,
"{
MR_TypeInfo type_info;
@@ -401,21 +404,24 @@
S = S0;
}").
-:- pragma c_code(set_ref(Ref::in, ValRef::in, S0::di, S::uo),
+:- pragma foreign_code("C",
+ set_ref(Ref::in, ValRef::in, S0::di, S::uo),
will_not_call_mercury,
"
* (MR_Word *) Ref = * (MR_Word *) ValRef;
S = S0;
").
-:- pragma c_code(set_ref_value(Ref::in, Val::di, S0::di, S::uo),
+:- pragma foreign_code("C",
+ set_ref_value(Ref::in, Val::di, S0::di, S::uo),
will_not_call_mercury,
"
* (MR_Word *) Ref = Val;
S = S0;
").
-:- pragma c_code(extract_ref_value(_S::di, Ref::in, Val::out),
+:- pragma foreign_code("C",
+ extract_ref_value(_S::di, Ref::in, Val::out),
will_not_call_mercury,
"
Val = * (MR_Word *) Ref;
@@ -423,7 +429,8 @@
%-----------------------------------------------------------------------------%
-:- pragma c_code(unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, S0::di, S::uo),
+:- pragma foreign_code("C",
+ unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, S0::di, S::uo),
will_not_call_mercury,
"{
/* unsafe - does not check type & arity, won't handle no_tag types */
@@ -432,7 +439,7 @@
S = S0;
}").
-:- pragma c_code(unsafe_new_arg_ref(Val::di, Arg::in, ArgRef::out,
+:- pragma foreign_code("C", unsafe_new_arg_ref(Val::di, Arg::in, ArgRef::out,
S0::di, S::uo), will_not_call_mercury,
"{
/* unsafe - does not check type & arity, won't handle no_tag types */
@@ -442,3 +449,94 @@
}").
%-----------------------------------------------------------------------------%
+
+:- pragma foreign_code("MC++", store__do_init(_S0::uo),
+ will_not_call_mercury, "").
+
+:- pragma foreign_code("MC++", new_mutvar(_Val::in, _Mutvar::out,
+ _S0::di, _S::uo), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++", get_mutvar(_Mutvar::in, _Val::out,
+ _S0::di, _S::uo), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++", set_mutvar(_Mutvar::in, _Val::in,
+ _S0::di, _S::uo), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++", unsafe_new_uninitialized_mutvar(
+ _Mutvar::out, _S0::di, _S::uo), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++", new_ref(_Val::di, _Ref::out, _S0::di, _S::uo),
+ will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++", unsafe_ref_value(_Ref::in, _Val::uo,
+ _S0::di, _S::uo), will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ arg_ref(_Ref::in, _ArgNum::in, _ArgRef::out, _S0::di, _S::uo),
+ will_not_call_mercury,
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+:- pragma foreign_code("MC++",
+ new_arg_ref(_Val::di, _ArgNum::in, _ArgRef::out, _S0::di, _S::uo),
+ will_not_call_mercury,
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+:- pragma foreign_code("MC++",
+ set_ref(_Ref::in, _ValRef::in, _S0::di, _S::uo),
+ will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ set_ref_value(_Ref::in, _Val::di, _S0::di, _S::uo),
+ will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ extract_ref_value(_S::di, _Ref::in, _Val::out),
+ will_not_call_mercury,
+"
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ unsafe_arg_ref(_Ref::in, _Arg::in, _ArgRef::out, _S0::di, _S::uo),
+ will_not_call_mercury,
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+:- pragma foreign_code("MC++",
+ unsafe_new_arg_ref(_Val::di, _Arg::in, _ArgRef::out,
+ _S0::di, _S::uo), will_not_call_mercury,
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+
+
Index: library/string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.140
diff -u -r1.140 string.m
--- library/string.m 2000/11/28 05:52:00 1.140
+++ library/string.m 2000/12/03 07:12:52
@@ -678,7 +678,7 @@
:- mode string__to_char_list(out, in) is det.
*/
-:- pragma c_code(string__to_char_list(Str::in, CharList::out),
+:- pragma foreign_code("C", string__to_char_list(Str::in, CharList::out),
[will_not_call_mercury, thread_safe], "{
MR_ConstString p = Str + strlen(Str);
CharList = MR_list_empty_msg(MR_PROC_LABEL);
@@ -689,7 +689,7 @@
}
}").
-:- pragma c_code(string__to_char_list(Str::out, CharList::in),
+:- pragma foreign_code("C", string__to_char_list(Str::out, CharList::in),
[will_not_call_mercury, thread_safe], "{
/* mode (out, in) is det */
MR_Word char_list_ptr;
@@ -732,7 +732,7 @@
% but the optimized implementation in C below is there for efficiency since
% it improves the overall speed of parsing by about 7%.
%
-:- pragma c_code(string__from_rev_char_list(Chars::in, Str::out),
+:- pragma foreign_code("C", string__from_rev_char_list(Chars::in, Str::out),
[will_not_call_mercury, thread_safe], "
{
MR_Word list_ptr;
@@ -771,6 +771,48 @@
}
}").
+:- pragma foreign_code("MC++", string__to_char_list(Str::in, CharList::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Integer length, i;
+ MR_Word tmp;
+ MR_Word prev;
+
+ length = Str->get_Length();
+
+ MR_list_nil(prev);
+
+ for (i = length - 1; i >= 0; i--) {
+ MR_list_cons(tmp, mr_convert::ToObject(Str->get_Chars(i)),
+ prev);
+ prev = tmp;
+ }
+ CharList = tmp;
+}").
+
+:- pragma foreign_code("MC++", string__to_char_list(Str::out, CharList::in),
+ [will_not_call_mercury, thread_safe], "{
+ Text::StringBuilder *tmp;
+ MR_Char c;
+
+ tmp = new Text::StringBuilder();
+ while (1) {
+ if (MR_list_is_cons(CharList)) {
+ c = mr_convert::ToChar(MR_list_head(CharList));
+ tmp->Append(c);
+ CharList = MR_list_tail(CharList);
+ } else {
+ break;
+ }
+ }
+ Str = tmp->ToString();
+}").
+
+:- pragma foreign_code("MC++", string__from_rev_char_list(_Chars::in,
+ _Str::out), [will_not_call_mercury, thread_safe], "
+{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
+
:- pred string__int_list_to_char_list(list(int), list(char)).
:- mode string__int_list_to_char_list(in, out) is det.
@@ -893,7 +935,7 @@
% Implementation of append_list that uses C as this minimises the
% amount of garbage created.
-:- pragma c_code(string__append_list(Strs::in) = (Str::out),
+:- pragma foreign_code("C", string__append_list(Strs::in) = (Str::out),
[will_not_call_mercury, thread_safe], "{
MR_Word list = Strs;
MR_Word tmp;
@@ -921,6 +963,12 @@
Str[len] = '\\0';
}").
+:- pragma foreign_code("MC++", string__append_list(_Strs::in) = (_Str::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
+
+
%-----------------------------------------------------------------------------%
% Note - string__hash is also defined in code/imp.h
@@ -950,7 +998,8 @@
%-----------------------------------------------------------------------------%
-:- pragma c_code(string__sub_string_search(WholeString::in, SubString::in,
+:- pragma foreign_code("C",
+ string__sub_string_search(WholeString::in, SubString::in,
Index::out) , [will_not_call_mercury, thread_safe],
"{
char *match;
@@ -963,6 +1012,13 @@
}
}").
+:- pragma foreign_code("MC++",
+ string__sub_string_search(_WholeString::in, _SubString::in,
+ _Index::out) , [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
+
%-----------------------------------------------------------------------------%
% This predicate has been optimised to produce the least memory
@@ -1331,54 +1387,86 @@
from_char_list(Prec), LengthMod, Spec]).
:- func int_length_modifer = string.
-:- pragma c_code(int_length_modifer = (LengthModifier::out),
+:- pragma foreign_code("C",
+ int_length_modifer = (LengthModifier::out),
[will_not_call_mercury, thread_safe], "{
MR_make_aligned_string(LengthModifier,
(MR_String) (MR_Word) MR_INTEGER_LENGTH_MODIFIER);
}").
+:- pragma foreign_code("MC++",
+ int_length_modifer = (_LengthModifier::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
+
% Create a string from a float using the format string.
% Note is is the responsibility of the caller to ensure that the
% format string is valid.
:- func format_float(string, float) = string.
-:- pragma c_code(format_float(FormatStr::in, Val::in) = (Str::out),
+:- pragma foreign_code("C",
+ format_float(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, thread_safe], "{
MR_save_transient_hp();
Str = MR_make_string(MR_PROC_LABEL, FormatStr, (long double) Val);
MR_restore_transient_hp();
}").
+:- pragma foreign_code("MC++",
+ format_float(_FormatStr::in, _Val::in) = (_Str::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
% Create a string from a int using the format string.
% Note is is the responsibility of the caller to ensure that the
% format string is valid.
:- func format_int(string, int) = string.
-:- pragma c_code(format_int(FormatStr::in, Val::in) = (Str::out),
+:- pragma foreign_code("C",
+ format_int(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, thread_safe], "{
MR_save_transient_hp();
Str = MR_make_string(MR_PROC_LABEL, FormatStr, Val);
MR_restore_transient_hp();
}").
+:- pragma foreign_code("MC++",
+ format_int(_FormatStr::in, _Val::in) = (_Str::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
% Create a string from a string using the format string.
% Note is is the responsibility of the caller to ensure that the
% format string is valid.
:- func format_string(string, string) = string.
-:- pragma c_code(format_string(FormatStr::in, Val::in) = (Str::out),
+:- pragma foreign_code("C",
+ format_string(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, thread_safe], "{
Str = MR_make_string(MR_PROC_LABEL, FormatStr, Val);
}").
+:- pragma foreign_code("MC++",
+ format_string(_FormatStr::in, _Val::in) = (_Str::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
% Create a string from a char using the format string.
% Note is is the responsibility of the caller to ensure that the
% format string is valid.
:- func format_char(string, char) = string.
-:- pragma c_code(format_char(FormatStr::in, Val::in) = (Str::out),
+:- pragma foreign_code("C",
+ format_char(FormatStr::in, Val::in) = (Str::out),
[will_not_call_mercury, thread_safe], "{
MR_save_transient_hp();
Str = MR_make_string(MR_PROC_LABEL, FormatStr, Val);
MR_restore_transient_hp();
}").
+:- pragma foreign_code("MC++",
+ format_char(_FormatStr::in, _Val::in) = (_Str::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
+
%-----------------------------------------------------------------------------%
@@ -1391,20 +1479,27 @@
%-----------------------------------------------------------------------------%
-:- pragma c_code(string__float_to_string(FloatVal::in, FloatString::out),
+:- pragma foreign_code("C",
+ string__float_to_string(FloatVal::in, FloatString::out),
[will_not_call_mercury, thread_safe], "{
char buf[500];
sprintf(buf, ""%#.15g"", FloatVal);
MR_allocate_aligned_string_msg(FloatString, strlen(buf), MR_PROC_LABEL);
strcpy(FloatString, buf);
}").
+:- pragma foreign_code("MC++",
+ string__float_to_string(_FloatVal::in, _FloatString::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
% Beware that the implementation of string__format depends
% on the details of what string__float_to_f_string/2 outputs.
:- pred string__float_to_f_string(float::in, string::out) is det.
-:- pragma c_code(string__float_to_f_string(FloatVal::in, FloatString::out),
+:- pragma foreign_code("C",
+ string__float_to_f_string(FloatVal::in, FloatString::out),
[will_not_call_mercury, thread_safe], "{
char buf[500];
sprintf(buf, ""%.15f"", FloatVal);
@@ -1412,7 +1507,8 @@
strcpy(FloatString, buf);
}").
-:- pragma c_code(string__to_float(FloatString::in, FloatVal::out),
+:- pragma foreign_code("C",
+ string__to_float(FloatString::in, FloatVal::out),
[will_not_call_mercury, thread_safe], "{
/* use a temporary, since we can't don't know whether FloatVal
is a double or float */
@@ -1422,6 +1518,18 @@
FloatVal = tmp;
}").
+:- pragma foreign_code("MC++",
+ string__float_to_f_string(_FloatVal::in, _FloatString::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
+
+:- pragma foreign_code("MC++",
+ string__to_float(_FloatString::in, _FloatVal::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
+
/*-----------------------------------------------------------------------*/
/*
@@ -1430,7 +1538,8 @@
:- mode string__to_int_list(out, in) is det.
*/
-:- pragma c_code(string__to_int_list(Str::in, IntList::out),
+:- pragma foreign_code("C",
+ string__to_int_list(Str::in, IntList::out),
[will_not_call_mercury, thread_safe], "{
MR_ConstString p = Str + strlen(Str);
IntList = MR_list_empty_msg(MR_PROC_LABEL);
@@ -1441,7 +1550,8 @@
}
}").
-:- pragma c_code(string__to_int_list(Str::out, IntList::in),
+:- pragma foreign_code("C",
+ string__to_int_list(Str::out, IntList::in),
[will_not_call_mercury, thread_safe], "{
/* mode (out, in) is det */
MR_Word int_list_ptr;
@@ -1478,16 +1588,57 @@
Str[size] = '\\0';
}").
+:- pragma foreign_code("MC++",
+ string__to_int_list(Str::in, IntList::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Integer length, i;
+ MR_Word tmp;
+ MR_Word prev;
+
+ length = Str->get_Length();
+
+ MR_list_nil(prev);
+
+ for (i = length - 1; i >= 0; i--) {
+ MR_list_cons(tmp, mr_convert::ToObject(Str->get_Chars(i)),
+ prev);
+ prev = tmp;
+ }
+ IntList = tmp;
+}").
+
+:- pragma foreign_code("MC++",
+ string__to_int_list(Str::out, IntList::in),
+ [will_not_call_mercury, thread_safe], "{
+ Text::StringBuilder *tmp;
+
+ tmp = new Text::StringBuilder();
+ while (1) {
+ if (mr_convert::ToInt32(IntList->GetValue(0))) {
+ tmp->Append(mr_convert::ToChar(IntList->GetValue(1)));
+ IntList = dynamic_cast<MR_Word>(IntList->GetValue(2));
+ } else {
+ break;
+ }
+ }
+ Str = tmp->ToString();
+}").
+
+
/*-----------------------------------------------------------------------*/
/*
:- pred string__contains_char(string, char).
:- mode string__contains_char(in, in) is semidet.
*/
-:- pragma c_code(string__contains_char(Str::in, Ch::in),
+:- pragma foreign_code("C", string__contains_char(Str::in, Ch::in),
[will_not_call_mercury, thread_safe], "
SUCCESS_INDICATOR = (strchr(Str, Ch) != NULL);
").
+:- pragma foreign_code("MC++", string__contains_char(_Str::in, _Ch::in),
+ [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""c code for this function"");
+").
/*-----------------------------------------------------------------------*/
@@ -1495,7 +1646,7 @@
:- pred string__index(string, int, char).
:- mode string__index(in, in, out) is semidet.
*/
-:- pragma c_code(string__index(Str::in, Index::in, Ch::out),
+:- pragma foreign_code("C", string__index(Str::in, Index::in, Ch::out),
[will_not_call_mercury, thread_safe], "
/*
@@ -1515,13 +1666,28 @@
Ch = Str[Index];
}
").
+:- pragma foreign_code("MC++", string__index(Str::in, Index::in, Ch::out),
+ [will_not_call_mercury, thread_safe], "
+ if (Index < 0 || Index >= Str->get_Length()) {
+ SUCCESS_INDICATOR = FALSE;
+ } else {
+ SUCCESS_INDICATOR = TRUE;
+ Ch = Str->get_Chars(Index);
+ }
+").
/*-----------------------------------------------------------------------*/
-:- pragma c_code(string__unsafe_index(Str::in, Index::in, Ch::out),
+:- pragma foreign_code("C",
+ string__unsafe_index(Str::in, Index::in, Ch::out),
[will_not_call_mercury, thread_safe], "
Ch = Str[Index];
").
+:- pragma foreign_code("MC++",
+ string__unsafe_index(Str::in, Index::in, Ch::out),
+ [will_not_call_mercury, thread_safe], "
+ Ch = Str->get_Chars(Index);
+").
/*-----------------------------------------------------------------------*/
@@ -1546,7 +1712,8 @@
:- pred string__set_char(char, int, string, string).
:- mode string__set_char(in, in, in, out) is semidet.
*/
-:- pragma c_code(string__set_char(Ch::in, Index::in, Str0::in, Str::out),
+:- pragma foreign_code("C",
+ string__set_char(Ch::in, Index::in, Str0::in, Str::out),
[will_not_call_mercury, thread_safe], "
size_t len = strlen(Str0);
if ((MR_Unsigned) Index >= len) {
@@ -1558,12 +1725,18 @@
MR_set_char(Str, Index, Ch);
}
").
+:- pragma foreign_code("MC++",
+ string__set_char(_Ch::in, _Index::in, _Str0::in, _Str::out),
+ [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""c code for this function"");
+").
/*
:- pred string__set_char(char, int, string, string).
:- mode string__set_char(in, in, di, uo) is semidet.
*/
-:- pragma c_code(string__set_char(Ch::in, Index::in, Str0::di, Str::uo),
+:- pragma foreign_code("C",
+ string__set_char(Ch::in, Index::in, Str0::di, Str::uo),
[will_not_call_mercury, thread_safe], "
if ((MR_Unsigned) Index >= strlen(Str0)) {
SUCCESS_INDICATOR = FALSE;
@@ -1573,6 +1746,11 @@
MR_set_char(Str, Index, Ch);
}
").
+:- pragma foreign_code("MC++",
+ string__set_char(_Ch::in, _Index::in, _Str0::di, _Str::uo),
+ [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""c code for this function"");
+").
/*-----------------------------------------------------------------------*/
@@ -1580,23 +1758,35 @@
:- pred string__unsafe_set_char(char, int, string, string).
:- mode string__unsafe_set_char(in, in, in, out) is det.
*/
-:- pragma c_code(string__unsafe_set_char(Ch::in, Index::in, Str0::in, Str::out),
+:- pragma foreign_code("C",
+ string__unsafe_set_char(Ch::in, Index::in, Str0::in, Str::out),
[will_not_call_mercury, thread_safe], "
size_t len = strlen(Str0);
MR_allocate_aligned_string_msg(Str, len, MR_PROC_LABEL);
strcpy(Str, Str0);
MR_set_char(Str, Index, Ch);
").
+:- pragma foreign_code("MC++",
+ string__unsafe_set_char(_Ch::in, _Index::in, _Str0::in, _Str::out),
+ [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""c code for this function"");
+").
/*
:- pred string__unsafe_set_char(char, int, string, string).
:- mode string__unsafe_set_char(in, in, di, uo) is det.
*/
-:- pragma c_code(string__unsafe_set_char(Ch::in, Index::in, Str0::di, Str::uo),
+:- pragma foreign_code("C",
+ string__unsafe_set_char(Ch::in, Index::in, Str0::di, Str::uo),
[will_not_call_mercury, thread_safe], "
Str = Str0;
MR_set_char(Str, Index, Ch);
").
+:- pragma foreign_code("MC++",
+ string__unsafe_set_char(_Ch::in, _Index::in, _Str0::di, _Str::uo),
+ [will_not_call_mercury, thread_safe], "
+ MR_Runtime::SORRY(""c code for this function"");
+").
/*-----------------------------------------------------------------------*/
@@ -1604,19 +1794,31 @@
:- pred string__length(string, int).
:- mode string__length(in, uo) is det.
*/
-:- pragma c_code(string__length(Str::in, Length::uo),
+:- pragma foreign_code("C",
+ string__length(Str::in, Length::uo),
[will_not_call_mercury, thread_safe], "
Length = strlen(Str);
").
+:- pragma foreign_code("MC++",
+ string__length(Str::in, Length::uo),
+ [will_not_call_mercury, thread_safe], "
+ Length = Str->get_Length();
+").
/*
:- pred string__length(string, int).
:- mode string__length(ui, uo) is det.
*/
-:- pragma c_code(string__length(Str::ui, Length::uo),
+:- pragma foreign_code("C",
+ string__length(Str::ui, Length::uo),
[will_not_call_mercury, thread_safe], "
Length = strlen(Str);
").
+:- pragma foreign_code("MC++",
+ string__length(Str::ui, Length::uo),
+ [will_not_call_mercury, thread_safe], "
+ Length = Str->get_Length();
+").
/*-----------------------------------------------------------------------*/
@@ -1631,7 +1833,8 @@
/*
:- mode string__append(in, in, in) is semidet.
*/
-:- pragma c_code(string__append(S1::in, S2::in, S3::in),
+:- pragma foreign_code("C",
+ string__append(S1::in, S2::in, S3::in),
[will_not_call_mercury, thread_safe], "{
size_t len_1 = strlen(S1);
SUCCESS_INDICATOR = (
@@ -1639,11 +1842,17 @@
strcmp(S2, S3 + len_1) == 0
);
}").
+:- pragma foreign_code("MC++",
+ string__append(_S1::in, _S2::in, _S3::in),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
/*
:- mode string__append(in, out, in) is semidet.
*/
-:- pragma c_code(string__append(S1::in, S2::out, S3::in),
+:- pragma foreign_code("C",
+ string__append(S1::in, S2::out,S3::in),
[will_not_call_mercury, thread_safe], "{
size_t len_1, len_2, len_3;
@@ -1662,11 +1871,17 @@
SUCCESS_INDICATOR = TRUE;
}
}").
+:- pragma foreign_code("MC++",
+ string__append(_S1::in, _S2::out, _S3::in),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
/*
:- mode string__append(in, in, out) is det.
*/
-:- pragma c_code(string__append(S1::in, S2::in, S3::out),
+:- pragma foreign_code("C",
+ string__append(S1::in, S2::in, S3::out),
[will_not_call_mercury, thread_safe], "{
size_t len_1, len_2;
len_1 = strlen(S1);
@@ -1675,8 +1890,14 @@
strcpy(S3, S1);
strcpy(S3 + len_1, S2);
}").
+:- pragma foreign_code("MC++",
+ string__append(S1::in, S2::in, S3::out),
+ [will_not_call_mercury, thread_safe], "{
+ S3 = String::Concat(S1, S2);
+}").
-:- pragma c_code(string__append(S1::out, S2::out, S3::in),
+:- pragma foreign_code("C",
+ string__append(S1::out, S2::out, S3::in),
[will_not_call_mercury, thread_safe],
local_vars("
MR_String s;
@@ -1707,6 +1928,20 @@
}
")
).
+:- pragma foreign_code("MC++",
+ string__append(_S1::out, _S2::out, _S3::in),
+ [will_not_call_mercury, thread_safe],
+ local_vars("
+ "),
+ first_code("
+ "),
+ retry_code("
+ "),
+ common_code("
+ MR_Runtime::SORRY(""c code for this function"");
+ ")
+).
+
/*-----------------------------------------------------------------------*/
@@ -1716,7 +1951,8 @@
% string__substring(String, Start, Count, Substring):
*/
-:- pragma c_code(string__substring(Str::in, Start::in, Count::in,
+:- pragma foreign_code("C",
+ string__substring(Str::in, Start::in, Count::in,
SubString::out),
[will_not_call_mercury, thread_safe],
"{
@@ -1736,6 +1972,13 @@
SubString[Count] = '\\0';
}
}").
+:- pragma foreign_code("MC++",
+ string__substring(_Str::in, _Start::in, _Count::in,
+ _SubString::out),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
/*
@@ -1744,7 +1987,8 @@
% string__unsafe_substring(String, Start, Count, Substring):
*/
-:- pragma c_code(string__unsafe_substring(Str::in, Start::in, Count::in,
+:- pragma foreign_code("C",
+ string__unsafe_substring(Str::in, Start::in, Count::in,
SubString::out),
[will_not_call_mercury, thread_safe],
"{
@@ -1753,8 +1997,16 @@
memcpy(SubString, Str + Start, Count);
SubString[Count] = '\\0';
}").
+:- pragma foreign_code("MC++",
+ string__unsafe_substring(_Str::in, _Start::in, _Count::in,
+ _SubString::out),
+ [will_not_call_mercury, thread_safe],
+"{
+ MR_Runtime::SORRY(""c code for this function"");
+}").
+
/*
:- pred string__split(string, int, string, string).
:- mode string__split(in, in, out, out) is det.
@@ -1765,7 +2017,8 @@
% treated as if it were the nearest end-point of that range.)
*/
-:- pragma c_code(string__split(Str::in, Count::in, Left::out, Right::out),
+:- pragma foreign_code("C",
+ string__split(Str::in, Count::in, Left::out, Right::out),
[will_not_call_mercury, thread_safe], "{
MR_Integer len;
MR_Word tmp;
@@ -1789,6 +2042,25 @@
}
}").
+:- pragma foreign_code("MC++",
+ string__split(Str::in, Count::in, Left::out, Right::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Integer len;
+ MR_Word tmp;
+ if (Count <= 0) {
+ Left = """";
+ Right = Str;
+ } else {
+ len = Str->get_Length();
+ if (Count > len) {
+ Count = len;
+ }
+ Left = Str->Substring(0, Count);
+ Right = Str->Substring(Count);
+ }
+}").
+
+
/*-----------------------------------------------------------------------*/
/*
@@ -1806,7 +2078,8 @@
/*
:- mode string__first_char(in, in, in) is semidet. % implied
*/
-:- pragma c_code(string__first_char(Str::in, First::in, Rest::in),
+:- pragma foreign_code("C",
+ string__first_char(Str::in, First::in, Rest::in),
[will_not_call_mercury, thread_safe], "
SUCCESS_INDICATOR = (
Str[0] == First &&
@@ -1814,20 +2087,44 @@
strcmp(Str + 1, Rest) == 0
);
").
+:- pragma foreign_code("MC++",
+ string__first_char(Str::in, First::in, Rest::in),
+ [will_not_call_mercury, thread_safe], "
+ MR_Integer len = Str->get_Length();
+ SUCCESS_INDICATOR = (
+ len > 0 &&
+ Str->get_Chars(0) == First &&
+ String::Compare(Str, 1, Rest, 0, len) == 0
+ );
+").
/*
:- mode string__first_char(in, out, in) is semidet. % implied
*/
-:- pragma c_code(string__first_char(Str::in, First::out, Rest::in),
+:- pragma foreign_code("C",
+ string__first_char(Str::in, First::out, Rest::in),
[will_not_call_mercury, thread_safe], "
First = Str[0];
SUCCESS_INDICATOR = (First != '\\0' && strcmp(Str + 1, Rest) == 0);
").
+:- pragma foreign_code("MC++",
+ string__first_char(Str::in, First::out, Rest::in),
+ [will_not_call_mercury, thread_safe], "
+ MR_Integer len = Str->get_Length();
+ if (len > 0) {
+ SUCCESS_INDICATOR =
+ (String::Compare(Str, 1, Rest, 0, len) == 0);
+ First = Str->get_Chars(0);
+ } else {
+ SUCCESS_INDICATOR = FALSE;
+ }
+").
/*
:- mode string__first_char(in, in, out) is semidet. % implied
*/
-:- pragma c_code(string__first_char(Str::in, First::in, Rest::out),
+:- pragma foreign_code("C",
+ string__first_char(Str::in, First::in, Rest::out),
[will_not_call_mercury, thread_safe], "{
if (Str[0] != First || First == '\\0') {
SUCCESS_INDICATOR = FALSE;
@@ -1843,11 +2140,23 @@
SUCCESS_INDICATOR = TRUE;
}
}").
+:- pragma foreign_code("MC++",
+ string__first_char(Str::in, First::in, Rest::out),
+ [will_not_call_mercury, thread_safe], "{
+ MR_Integer len = Str->get_Length();
+ if (len > 0) {
+ SUCCESS_INDICATOR = (First == Str->get_Chars(0) &&
+ String::Compare(Str, 1, Rest, 0, len) == 0);
+ } else {
+ SUCCESS_INDICATOR = FALSE;
+ }
+}").
/*
:- mode string__first_char(in, out, out) is semidet.
*/
-:- pragma c_code(string__first_char(Str::in, First::out, Rest::out),
+:- pragma foreign_code("C",
+ string__first_char(Str::in, First::out, Rest::out),
[will_not_call_mercury, thread_safe], "{
First = Str[0];
if (First == '\\0') {
@@ -1864,17 +2173,38 @@
SUCCESS_INDICATOR = TRUE;
}
}").
+:- pragma foreign_code("MC++",
+ string__first_char(Str::in, First::out, Rest::out),
+ [will_not_call_mercury, thread_safe], "{
+ if (Str->get_Length() == 0) {
+ SUCCESS_INDICATOR = FALSE;
+ } else {
+ First = Str->get_Chars(0);
+ Rest = (Str)->Substring(1);
+ SUCCESS_INDICATOR = TRUE;
+ }
+}").
+
/*
:- mode string__first_char(out, in, in) is det.
*/
-:- pragma c_code(string__first_char(Str::out, First::in, Rest::in),
+:- pragma foreign_code("C",
+ string__first_char(Str::out, First::in, Rest::in),
[will_not_call_mercury, thread_safe], "{
size_t len = strlen(Rest) + 1;
MR_allocate_aligned_string_msg(Str, len, MR_PROC_LABEL);
Str[0] = First;
strcpy(Str + 1, Rest);
}").
+:- pragma foreign_code("MC++",
+ string__first_char(Str::out, First::in, Rest::in),
+ [will_not_call_mercury, thread_safe], "{
+ MR_String FirstStr;
+ FirstStr = new String(First, 1);
+ Str = String::Concat(FirstStr, Rest);
+}").
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/table_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/table_builtin.m,v
retrieving revision 1.3
diff -u -r1.3 table_builtin.m
--- library/table_builtin.m 2000/11/23 02:00:17 1.3
+++ library/table_builtin.m 2000/12/03 06:23:25
@@ -179,7 +179,8 @@
:- implementation.
-:- pragma c_code(table_simple_is_complete(T::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_simple_is_complete(T::in), will_not_call_mercury, "
MR_TrieNode table;
table = (MR_TrieNode) T;
@@ -196,7 +197,8 @@
|| (table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED));
").
-:- pragma c_code(table_simple_has_succeeded(T::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_simple_has_succeeded(T::in), will_not_call_mercury, "
MR_TrieNode table;
table = (MR_TrieNode) T;
@@ -212,7 +214,8 @@
(table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED);
").
-:- pragma c_code(table_simple_has_failed(T::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_simple_has_failed(T::in), will_not_call_mercury, "
MR_TrieNode table;
table = (MR_TrieNode) T;
@@ -228,7 +231,8 @@
(table->MR_simpletable_status == MR_SIMPLETABLE_FAILED);
").
-:- pragma c_code(table_simple_is_active(T::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_simple_is_active(T::in), will_not_call_mercury, "
MR_TrieNode table;
table = (MR_TrieNode) T;
@@ -244,7 +248,8 @@
(table->MR_simpletable_status == MR_SIMPLETABLE_WORKING);
").
-:- pragma c_code(table_simple_is_inactive(T::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_simple_is_inactive(T::in), will_not_call_mercury, "
MR_TrieNode table;
table = (MR_TrieNode) T;
@@ -260,7 +265,8 @@
(table->MR_simpletable_status != MR_SIMPLETABLE_WORKING);
").
-:- pragma c_code(table_simple_mark_as_succeeded(T::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_simple_mark_as_succeeded(T::in), will_not_call_mercury, "
MR_TrieNode table;
table = (MR_TrieNode) T;
@@ -273,7 +279,8 @@
table->MR_simpletable_status = MR_SIMPLETABLE_SUCCEEDED;
").
-:- pragma c_code(table_simple_mark_as_failed(T::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_simple_mark_as_failed(T::in), will_not_call_mercury, "
MR_TrieNode table;
table = (MR_TrieNode) T;
@@ -286,7 +293,8 @@
table->MR_simpletable_status = MR_SIMPLETABLE_FAILED;
").
-:- pragma c_code(table_simple_mark_as_active(T::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_simple_mark_as_active(T::in), will_not_call_mercury, "
MR_TrieNode table;
table = (MR_TrieNode) T;
@@ -299,7 +307,8 @@
table->MR_simpletable_status = MR_SIMPLETABLE_WORKING;
").
-:- pragma c_code(table_simple_mark_as_inactive(T::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_simple_mark_as_inactive(T::in), will_not_call_mercury, "
MR_TrieNode table;
table = (MR_TrieNode) T;
@@ -312,6 +321,53 @@
table->MR_simpletable_status = MR_SIMPLETABLE_UNINITIALIZED;
").
+
+
+:- pragma foreign_code("MC++",
+ table_simple_is_complete(_T::in), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_simple_has_succeeded(_T::in), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_simple_has_failed(_T::in), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_simple_is_active(_T::in), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_simple_is_inactive(_T::in), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_simple_mark_as_succeeded(_T::in), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_simple_mark_as_failed(_T::in), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_simple_mark_as_active(_T::in), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_simple_mark_as_inactive(_T::in), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
%-----------------------------------------------------------------------------%
:- interface.
@@ -379,7 +435,8 @@
:- implementation.
-:- pragma c_code(table_nondet_setup(T0::in, T::out), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_nondet_setup(T0::in, T::out), will_not_call_mercury, "
#ifndef MR_USE_MINIMAL_MODEL
MR_fatal_error(""minimal model code entered when not enabled"");
#else
@@ -440,12 +497,39 @@
#endif /* MR_USE_MINIMAL_MODEL */
").
+:- pragma foreign_code("MC++",
+ table_nondet_setup(_T0::in, _T::out), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
% The definitions of these two predicates are in the runtime system,
% in runtime/mercury_tabling.c.
:- external(table_nondet_suspend/2).
:- external(table_nondet_resume/1).
-:- pragma c_code(table_nondet_is_complete(T::in),"
+/*
+
+XXX :- external stops us from using this
+
+:- pragma foreign_code("MC++",
+ table_nondet_suspend(_A::in, _B::out), [will_not_call_mercury],
+ local_vars(""),
+ first_code(""),
+ retry_code(""),
+ common_code("
+ MR_Runtime::SORRY(""foreign code for this function"");
+ ")
+).
+
+:- pragma foreign_code("MC++",
+ table_nondet_resume(_A::in), [will_not_call_mercury], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+*/
+
+:- pragma foreign_code("C",
+ table_nondet_is_complete(T::in), [will_not_call_mercury], "
#ifdef MR_USE_MINIMAL_MODEL
MR_TrieNode table;
@@ -457,7 +541,8 @@
#endif
").
-:- pragma c_code(table_nondet_is_active(T::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_nondet_is_active(T::in), will_not_call_mercury, "
#ifdef MR_USE_MINIMAL_MODEL
MR_TrieNode table;
@@ -469,7 +554,8 @@
#endif
").
-:- pragma c_code(table_nondet_mark_as_active(T::in), will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_nondet_mark_as_active(T::in), will_not_call_mercury, "
#ifdef MR_USE_MINIMAL_MODEL
MR_TrieNode table;
@@ -483,7 +569,8 @@
#endif
").
-:- pragma c_code(table_nondet_get_ans_table(T::in, AT::out),
+:- pragma foreign_code("C",
+ table_nondet_get_ans_table(T::in, AT::out),
will_not_call_mercury, "
#ifdef MR_USE_MINIMAL_MODEL
MR_TrieNode table;
@@ -496,7 +583,8 @@
#endif
").
-:- pragma c_code(table_nondet_answer_is_not_duplicate(T::in),
+:- pragma foreign_code("C",
+ table_nondet_answer_is_not_duplicate(T::in),
will_not_call_mercury, "
#ifndef MR_USE_MINIMAL_MODEL
MR_fatal_error(""minimal model code entered when not enabled"");
@@ -519,7 +607,8 @@
#endif
").
-:- pragma c_code(table_nondet_new_ans_slot(T::in, Slot::out),
+:- pragma foreign_code("C",
+ table_nondet_new_ans_slot(T::in, Slot::out),
will_not_call_mercury, "
#ifndef MR_USE_MINIMAL_MODEL
MR_fatal_error(""minimal model code entered when not enabled"");
@@ -564,7 +653,8 @@
** table_multi_return_all_ans/2 (below).
** Any changes to this code should also be made there.
*/
-:- pragma c_code(table_nondet_return_all_ans(T::in, A::out),
+:- pragma foreign_code("C",
+ table_nondet_return_all_ans(T::in, A::out),
will_not_call_mercury,
local_vars("
#ifdef MR_USE_MINIMAL_MODEL
@@ -611,7 +701,8 @@
** table_nondet_return_all_ans/2 (above).
** Any changes to this code should also be made there.
*/
-:- pragma c_code(table_multi_return_all_ans(T::in, A::out),
+:- pragma foreign_code("C",
+ table_multi_return_all_ans(T::in, A::out),
will_not_call_mercury,
local_vars("
#ifdef MR_USE_MINIMAL_MODEL
@@ -652,6 +743,73 @@
#endif
")
).
+
+
+:- pragma foreign_code("MC++",
+ table_nondet_is_complete(_T::in), [will_not_call_mercury], "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_nondet_is_active(_T::in), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_nondet_mark_as_active(_T::in), will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_nondet_get_ans_table(_T::in, _AT::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_nondet_answer_is_not_duplicate(_T::in),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_nondet_new_ans_slot(_T::in, _Slot::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_nondet_return_all_ans(_T::in, _A::out),
+ will_not_call_mercury,
+ local_vars("
+ "),
+ first_code("
+ "),
+ retry_code("
+ "),
+ shared_code("
+ MR_Runtime::SORRY(""foreign code for this function"");
+ ")
+).
+
+/*
+** Note that the code for this is identical to the code for
+** table_nondet_return_all_ans/2 (above).
+** Any changes to this code should also be made there.
+*/
+:- pragma foreign_code("MC++",
+ table_multi_return_all_ans(_T::in, _A::out),
+ will_not_call_mercury,
+ local_vars("
+ "),
+ first_code("
+ "),
+ retry_code("
+ "),
+ shared_code("
+ MR_Runtime::SORRY(""foreign code for this function"");
+ ")
+).
%-----------------------------------------------------------------------------%
:- interface.
@@ -760,7 +918,7 @@
:- implementation.
:- import_module require.
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include ""mercury_misc.h"" /* for MR_fatal_error(); */
#include ""mercury_type_info.h"" /* for MR_TypeCtorInfo_Struct; */
@@ -777,7 +935,7 @@
").
-:- pragma c_code(table_lookup_insert_int(T0::in, I::in, T::out),
+:- pragma foreign_code("C", table_lookup_insert_int(T0::in, I::in, T::out),
will_not_call_mercury, "
MR_TrieNode table0, table;
@@ -786,7 +944,7 @@
T = (MR_Word) table;
").
-:- pragma c_code(table_lookup_insert_char(T0::in, C::in, T::out),
+:- pragma foreign_code("C", table_lookup_insert_char(T0::in, C::in, T::out),
will_not_call_mercury, "
MR_TrieNode table0, table;
@@ -795,7 +953,7 @@
T = (MR_Word) table;
").
-:- pragma c_code(table_lookup_insert_string(T0::in, S::in, T::out),
+:- pragma foreign_code("C", table_lookup_insert_string(T0::in, S::in, T::out),
will_not_call_mercury, "
MR_TrieNode table0, table;
@@ -804,7 +962,7 @@
T = (MR_Word) table;
").
-:- pragma c_code(table_lookup_insert_float(T0::in, F::in, T::out),
+:- pragma foreign_code("C", table_lookup_insert_float(T0::in, F::in, T::out),
will_not_call_mercury, "
MR_TrieNode table0, table;
@@ -813,7 +971,8 @@
T = (MR_Word) table;
").
-:- pragma c_code(table_lookup_insert_enum(T0::in, R::in, V::in, T::out),
+:- pragma foreign_code("C",
+ table_lookup_insert_enum(T0::in, R::in, V::in, T::out),
will_not_call_mercury, "
MR_TrieNode table0, table;
@@ -822,7 +981,8 @@
T = (MR_Word) table;
").
-:- pragma c_code(table_lookup_insert_user(T0::in, V::in, T::out),
+:- pragma foreign_code("C",
+ table_lookup_insert_user(T0::in, V::in, T::out),
will_not_call_mercury, "
MR_TrieNode table0, table;
@@ -831,7 +991,8 @@
T = (MR_Word) table;
").
-:- pragma c_code(table_lookup_insert_poly(T0::in, V::in, T::out),
+:- pragma foreign_code("C",
+ table_lookup_insert_poly(T0::in, V::in, T::out),
will_not_call_mercury, "
MR_TrieNode table0, table;
@@ -840,7 +1001,8 @@
T = (MR_Word) table;
").
-:- pragma c_code(table_save_int_ans(T::in, Offset::in, I::in),
+:- pragma foreign_code("C",
+ table_save_int_ans(T::in, Offset::in, I::in),
will_not_call_mercury, "
MR_TrieNode table;
@@ -849,7 +1011,8 @@
&mercury_data___type_ctor_info_int_0);
").
-:- pragma c_code(table_save_char_ans(T::in, Offset::in, C::in),
+:- pragma foreign_code("C",
+ table_save_char_ans(T::in, Offset::in, C::in),
will_not_call_mercury, "
MR_TrieNode table;
@@ -858,7 +1021,8 @@
&mercury_data___type_ctor_info_character_0);
").
-:- pragma c_code(table_save_string_ans(T::in, Offset::in, S::in),
+:- pragma foreign_code("C",
+ table_save_string_ans(T::in, Offset::in, S::in),
will_not_call_mercury, "
MR_TrieNode table;
@@ -867,7 +1031,8 @@
&mercury_data___type_ctor_info_string_0);
").
-:- pragma c_code(table_save_float_ans(T::in, Offset::in, F::in),
+:- pragma foreign_code("C",
+ table_save_float_ans(T::in, Offset::in, F::in),
will_not_call_mercury, "
MR_TrieNode table;
@@ -883,7 +1048,8 @@
#endif
").
-:- pragma c_code(table_save_any_ans(T::in, Offset::in, V::in),
+:- pragma foreign_code("C",
+ table_save_any_ans(T::in, Offset::in, V::in),
will_not_call_mercury, "
MR_TrieNode table;
@@ -891,7 +1057,8 @@
MR_TABLE_SAVE_ANSWER(table, Offset, V, TypeInfo_for_T);
").
-:- pragma c_code(table_restore_int_ans(T::in, Offset::in, I::out),
+:- pragma foreign_code("C",
+ table_restore_int_ans(T::in, Offset::in, I::out),
will_not_call_mercury, "
MR_TrieNode table;
@@ -899,7 +1066,8 @@
I = (MR_Integer) MR_TABLE_GET_ANSWER(table, Offset);
").
-:- pragma c_code(table_restore_char_ans(T::in, Offset::in, C::out),
+:- pragma foreign_code("C",
+ table_restore_char_ans(T::in, Offset::in, C::out),
will_not_call_mercury, "
MR_TrieNode table;
@@ -907,7 +1075,8 @@
C = (MR_Char) MR_TABLE_GET_ANSWER(table, Offset);
").
-:- pragma c_code(table_restore_string_ans(T::in, Offset::in, S::out),
+:- pragma foreign_code("C",
+ table_restore_string_ans(T::in, Offset::in, S::out),
will_not_call_mercury, "
MR_TrieNode table;
@@ -915,7 +1084,8 @@
S = (MR_String) MR_TABLE_GET_ANSWER(table, Offset);
").
-:- pragma c_code(table_restore_float_ans(T::in, Offset::in, F::out),
+:- pragma foreign_code("C",
+ table_restore_float_ans(T::in, Offset::in, F::out),
will_not_call_mercury, "
MR_TrieNode table;
@@ -927,7 +1097,8 @@
#endif
").
-:- pragma c_code(table_restore_any_ans(T::in, Offset::in, V::out),
+:- pragma foreign_code("C",
+ table_restore_any_ans(T::in, Offset::in, V::out),
will_not_call_mercury, "
MR_TrieNode table;
@@ -935,7 +1106,8 @@
V = (MR_Word) MR_TABLE_GET_ANSWER(table, Offset);
").
-:- pragma c_code(table_create_ans_block(T0::in, Size::in, T::out),
+:- pragma foreign_code("C",
+ table_create_ans_block(T0::in, Size::in, T::out),
will_not_call_mercury, "
MR_TrieNode table0;
@@ -947,9 +1119,125 @@
table_loopcheck_error(Message) :-
error(Message).
-:- pragma c_code(table_report_statistics, will_not_call_mercury, "
+:- pragma foreign_code("C",
+ table_report_statistics, will_not_call_mercury, "
MR_table_report_statistics(stderr);
").
+
+
+:- pragma foreign_code("MC++",
+ table_lookup_insert_int(_T0::in, _I::in, _T::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_lookup_insert_char(_T0::in, _C::in, _T::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_lookup_insert_string(_T0::in, _S::in, _T::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_lookup_insert_float(_T0::in, _F::in, _T::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_lookup_insert_enum(_T0::in, _R::in, _V::in, _T::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_lookup_insert_user(_T0::in, _V::in, _T::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_lookup_insert_poly(_T0::in, _V::in, _T::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_save_int_ans(_T::in, _Offset::in, _I::in),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_save_char_ans(_T::in, _Offset::in, _C::in),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_save_string_ans(_T::in, _Offset::in, _S::in),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_save_float_ans(_T::in, _Offset::in, _F::in),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_save_any_ans(_T::in, _Offset::in, _V::in),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_restore_int_ans(_T::in, _Offset::in, _I::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_restore_char_ans(_T::in, _Offset::in, _C::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_restore_string_ans(_T::in, _Offset::in, _S::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_restore_float_ans(_T::in, _Offset::in, _F::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_restore_any_ans(_T::in, _Offset::in, _V::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_create_ans_block(_T0::in, _Size::in, _T::out),
+ will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
+:- pragma foreign_code("MC++",
+ table_report_statistics, will_not_call_mercury, "
+ MR_Runtime::SORRY(""foreign code for this function"");
+").
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/term.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.99
diff -u -r1.99 term.m
--- library/term.m 2000/11/12 08:51:38 1.99
+++ library/term.m 2000/12/01 03:34:05
@@ -38,8 +38,9 @@
:- type var(T).
:- type var_supply(T).
+ % XXX and another warning!
:- type generic
- ---> generic.
+ ---> generic ; aaa.
:- type term == term(generic).
:- type var == var(generic).
Index: library/time.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/time.m,v
retrieving revision 1.17
diff -u -r1.17 time.m
--- library/time.m 2000/10/16 01:33:52 1.17
+++ library/time.m 2000/12/01 03:34:05
@@ -179,13 +179,19 @@
:- pred time__c_clock(int, io__state, io__state).
:- mode time__c_clock(out, di, uo) is det.
-:- pragma c_code(time__c_clock(Ret::out, IO0::di, IO::uo),
+:- pragma foreign_code("C", time__c_clock(Ret::out, IO0::di, IO::uo),
[will_not_call_mercury],
"{
Ret = (MR_Integer) clock();
update_io(IO0, IO);
}").
+:- pragma foreign_code("MC++", time__c_clock(_Ret::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
%-----------------------------------------------------------------------------%
%:- func time__clocks_per_sec = int.
@@ -196,11 +202,16 @@
:- pred time__c_clocks_per_sec(int).
:- mode time__c_clocks_per_sec(out) is det.
-:- pragma c_code(time__c_clocks_per_sec(Ret::out),
+:- pragma foreign_code("C", time__c_clocks_per_sec(Ret::out),
[will_not_call_mercury],
"{
Ret = (MR_Integer) CLOCKS_PER_SEC;
}").
+:- pragma foreign_code("MC++", time__c_clocks_per_sec(_Ret::out),
+ [will_not_call_mercury],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
%-----------------------------------------------------------------------------%
@@ -219,7 +230,8 @@
:- pred time__c_times(int, int, int, int, int, io__state, io__state).
:- mode time__c_times(out, out, out, out, out, di, uo) is det.
-:- pragma c_code(time__c_times(Ret::out, Ut::out, St::out, CUt::out,
+:- pragma foreign_code("C",
+ time__c_times(Ret::out, Ut::out, St::out, CUt::out,
CSt::out, IO0::di, IO::uo),
[will_not_call_mercury],
"{
@@ -237,6 +249,14 @@
#endif
update_io(IO0, IO);
}").
+:- pragma foreign_code("MC++",
+ time__c_times(_Ret::out, _Ut::out, _St::out, _CUt::out,
+ _CSt::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
%-----------------------------------------------------------------------------%
@@ -254,12 +274,19 @@
:- pred time__c_time(int, io__state, io__state).
:- mode time__c_time(out, di, uo) is det.
-:- pragma c_code(time__c_time(Ret::out, IO0::di, IO::uo),
+:- pragma foreign_code("C",
+ time__c_time(Ret::out, IO0::di, IO::uo),
[will_not_call_mercury],
"{
Ret = (MR_Integer) time(NULL);
update_io(IO0, IO);
}").
+:- pragma foreign_code("MC++",
+ time__c_time(_Ret::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
%-----------------------------------------------------------------------------%
@@ -271,11 +298,18 @@
:- pred time__c_difftime(int, int, float).
:- mode time__c_difftime(in, in, out) is det.
-:- pragma c_code(time__c_difftime(T1::in, T0::in, Diff::out),
+:- pragma foreign_code("C",
+ time__c_difftime(T1::in, T0::in, Diff::out),
[will_not_call_mercury],
"{
Diff = (MR_Float) difftime((time_t) T1, (time_t) T0);
}").
+:- pragma foreign_code("MC++",
+ time__c_difftime(_T1::in, _T0::in, _Diff::out),
+ [will_not_call_mercury],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
%-----------------------------------------------------------------------------%
@@ -295,7 +329,8 @@
:- pred time__c_localtime(int, int, int, int, int, int, int, int, int).
:- mode time__c_localtime(in, out, out, out, out, out, out, out, out) is det.
-:- pragma c_code(time__c_localtime(Time::in, Sec::out, Min::out, Hrs::out,
+:- pragma foreign_code("C",
+ time__c_localtime(Time::in, Sec::out, Min::out, Hrs::out,
WD::out, YD::out, Mnt::out,
Yr::out, N::out),
[will_not_call_mercury],
@@ -319,6 +354,16 @@
N = (MR_Integer) p->tm_isdst;
}").
+:- pragma foreign_code("MC++",
+ time__c_localtime(_Time::in, _Sec::out, _Min::out, _Hrs::out,
+ _WD::out, _YD::out, _Mnt::out,
+ _Yr::out, _N::out),
+ [will_not_call_mercury],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+
%:- func time__gmtime(time_t) = tm.
time__gmtime(Time) = TM :-
@@ -335,7 +380,8 @@
:- pred time__c_gmtime(int, int, int, int, int, int, int, int, int).
:- mode time__c_gmtime(in, out, out, out, out, out, out, out, out) is det.
-:- pragma c_code(time__c_gmtime(Time::in, Sec::out, Min::out, Hrs::out,
+:- pragma foreign_code("C",
+ time__c_gmtime(Time::in, Sec::out, Min::out, Hrs::out,
WD::out, YD::out, Mnt::out,
Yr::out, N::out),
[will_not_call_mercury],
@@ -359,6 +405,16 @@
N = (MR_Integer) p->tm_isdst;
}").
+:- pragma foreign_code("MC++",
+ time__c_gmtime(_Time::in, _Sec::out, _Min::out, _Hrs::out,
+ _WD::out, _YD::out, _Mnt::out,
+ _Yr::out, _N::out),
+ [will_not_call_mercury],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+
%-----------------------------------------------------------------------------%
%:- func time__mktime(tm) = time_t.
@@ -377,7 +433,8 @@
:- pred time__c_mktime(int, int, int, int, int, int, int, int, int).
:- mode time__c_mktime(in, in, in, in, in, in, in, in, out) is det.
-:- pragma c_code(time__c_mktime(Sec::in, Min::in, Hrs::in, WD::in,
+:- pragma foreign_code("C",
+ time__c_mktime(Sec::in, Min::in, Hrs::in, WD::in,
YD::in, Mnt::in, Yr::in,
N::in, Time::out),
[will_not_call_mercury],
@@ -396,6 +453,16 @@
Time = (MR_Integer) mktime(&t);
}").
+:- pragma foreign_code("MC++",
+ time__c_mktime(_Sec::in, _Min::in, _Hrs::in, _WD::in,
+ _YD::in, _Mnt::in, _Yr::in,
+ _N::in, _Time::out),
+ [will_not_call_mercury],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
+
%-----------------------------------------------------------------------------%
%:- func time__asctime(tm) = string.
@@ -414,7 +481,8 @@
:- pred time__c_asctime(int, int, int, int, int, int, int, int, string).
:- mode time__c_asctime(in, in, in, in, in, in, in, in, out) is det.
-:- pragma c_code(time__c_asctime(Sec::in, Min::in, Hrs::in, WD::in,
+:- pragma foreign_code("C",
+ time__c_asctime(Sec::in, Min::in, Hrs::in, WD::in,
YD::in, Mnt::in, Yr::in, N::in, Str::out),
[will_not_call_mercury],
"{
@@ -435,6 +503,15 @@
MR_make_aligned_string_copy(Str, s);
}").
+:- pragma foreign_code("MC++",
+ time__c_asctime(_Sec::in, _Min::in, _Hrs::in, _WD::in,
+ _YD::in, _Mnt::in, _Yr::in, _N::in,
+ _Str::out),
+ [will_not_call_mercury],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
%-----------------------------------------------------------------------------%
%:- func time__ctime(time_t) = string.
@@ -445,7 +522,8 @@
:- pred time__c_ctime(int, string).
:- mode time__c_ctime(in, out) is det.
-:- pragma c_code(time__c_ctime(Time::in, Str::out),
+:- pragma foreign_code("C",
+ time__c_ctime(Time::in, Str::out),
[will_not_call_mercury],
"{
char *s;
@@ -457,6 +535,14 @@
MR_make_aligned_string_copy(Str, s);
}").
+
+:- pragma foreign_code("MC++",
+ time__c_ctime(_Time::in, _Str::out),
+ [will_not_call_mercury],
+"{
+ MR_Runtime::SORRY(""foreign code for this function"");
+}").
+
%-----------------------------------------------------------------------------%
:- end_module time.
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.63
diff -u -r1.63 Mmakefile
--- runtime/Mmakefile 2000/10/11 03:00:15 1.63
+++ runtime/Mmakefile 2000/12/01 00:14:21
@@ -209,6 +209,14 @@
#-----------------------------------------------------------------------------#
+ifeq ($(GRADE),ilc)
+
+MSCL_NOASM=:noAssembly
+
+runtime: mercury_il.dll mercury_cpp.dll
+
+else
+
.PHONY: runtime
runtime: lib$(RT_LIB_NAME).$A lib$(RT_LIB_NAME).$(EXT_FOR_SHARED_LIB)
runtime: $(RT_LIB_NAME).init
@@ -225,6 +233,8 @@
$(SHLIB_RPATH_OPT)$(FINAL_INSTALL_MERC_GC_LIB_DIR) \
$(LDFLAGS) $(LDLIBS) $(THREADLIBS) \
$(SHARED_LIBS)
+
+endif
$(RT_LIB_NAME).init: $(CFILES)
cat `vpath_find $(CFILES)` | grep '^INIT ' > $(RT_LIB_NAME).init
Index: runtime/mercury_cpp.cpp
===================================================================
RCS file: mercury_cpp.cpp
diff -N mercury_cpp.cpp
--- /dev/null Tue Nov 21 11:53:28 2000
+++ mercury_cpp.cpp Mon Dec 4 21:47:42 2000
@@ -0,0 +1,149 @@
+// vi: ts=4 sw=4 et tw=0 wm=0
+
+#using <mscorlib.dll>
+#using "mercury_il.dll"
+using namespace System;
+
+ // This line (somehow) stops the compiler from
+ // linking in the C library (and it will then complain about main being
+ // missing)
+extern "C" int _fltused=0;
+
+#include "mercury_cpp.h"
+using namespace mercury;
+
+namespace mercury {
+
+
+__gc public class mercury_exception : public Exception
+{
+public:
+ mercury_exception()
+ { }
+
+ mercury_exception(MR_String Msg) : Exception(Msg)
+ {
+ }
+};
+
+
+
+__gc public class mr_convert
+{
+ public:
+ static MR_Box ToObject(MR_Integer x)
+ {
+ return convert_imp::ToObject(x);
+ }
+ static MR_Box ToObject(MR_Char x)
+ {
+ return convert_imp::ToObject((MR_Integer) x);
+ }
+ static MR_Box ToObject(MR_Word x)
+ {
+ return x;
+ }
+
+
+ static MR_Char ToChar(MR_Box x)
+ {
+ return (Char) convert_imp::ToInt32(x);
+ }
+ static MR_Integer ToInt32(MR_Box x)
+ {
+ return convert_imp::ToInt32(x);
+ }
+ static MR_Float ToDouble(MR_Box x)
+ {
+ return convert_imp::ToFloat64(x);
+ }
+ static MR_Word ToArray(MR_Box x)
+ {
+ return dynamic_cast<MR_Word>(x);
+ }
+};
+
+
+__gc public class MR_Runtime {
+ public:
+ static void SORRY(MR_String s)
+ {
+ MR_String msg;
+ mercury_exception *ex;
+
+ msg = String::Concat("Sorry, unimplemented: ", s);
+
+ ex = new mercury_exception(msg);
+ throw ex;
+ }
+
+ static void MR_fatal_error(MR_String s)
+ {
+ MR_String msg;
+ mercury_exception *ex;
+
+ msg = String::Concat("Fatal error: ", s);
+
+ ex = new mercury_exception(msg);
+ throw ex;
+ }
+
+ static int MR_TYPECTOR_REP_ENUM = MR_TYPECTOR_REP_ENUM_val;
+ static int MR_TYPECTOR_REP_ENUM_USEREQ = MR_TYPECTOR_REP_ENUM_USEREQ_val;
+ static int MR_TYPECTOR_REP_DU = MR_TYPECTOR_REP_DU_val;
+ static int MR_TYPECTOR_REP_DU_USEREQ = 3;
+ static int MR_TYPECTOR_REP_NOTAG = 4;
+ static int MR_TYPECTOR_REP_NOTAG_USEREQ = 5;
+ static int MR_TYPECTOR_REP_EQUIV = 6;
+ static int MR_TYPECTOR_REP_EQUIV_VAR = 7;
+ static int MR_TYPECTOR_REP_INT = 8;
+ static int MR_TYPECTOR_REP_CHAR = 9;
+ static int MR_TYPECTOR_REP_FLOAT =10;
+ static int MR_TYPECTOR_REP_STRING =11;
+ static int MR_TYPECTOR_REP_PRED =12;
+ static int MR_TYPECTOR_REP_UNIV =13;
+ static int MR_TYPECTOR_REP_VOID =14;
+ static int MR_TYPECTOR_REP_C_POINTER =15;
+ static int MR_TYPECTOR_REP_TYPEINFO =16;
+ static int MR_TYPECTOR_REP_TYPECLASSINFO =17;
+ static int MR_TYPECTOR_REP_ARRAY =18;
+ static int MR_TYPECTOR_REP_SUCCIP =19;
+ static int MR_TYPECTOR_REP_HP =20;
+ static int MR_TYPECTOR_REP_CURFR =21;
+ static int MR_TYPECTOR_REP_MAXFR =22;
+ static int MR_TYPECTOR_REP_REDOFR =23;
+ static int MR_TYPECTOR_REP_REDOIP =24;
+ static int MR_TYPECTOR_REP_TRAIL_PTR =25;
+ static int MR_TYPECTOR_REP_TICKET =26;
+ static int MR_TYPECTOR_REP_NOTAG_GROUND =27;
+ static int MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ =28;
+ static int MR_TYPECTOR_REP_EQUIV_GROUND =29;
+
+ static int MR_SECTAG_NONE = 0;
+ static int MR_SECTAG_LOCAL = 1;
+ static int MR_SECTAG_REMOTE = 2;
+
+};
+
+__gc public class envptr
+{
+public:
+};
+
+__gc public class continuation
+{
+public:
+ envptr *a;
+ continuation() {
+ this->a = new envptr();
+
+ }
+};
+
+__gc public class commit : public Exception
+{
+public:
+};
+
+}
+
Index: runtime/mercury_il.il
===================================================================
RCS file: mercury_il.il
diff -N mercury_il.il
--- /dev/null Tue Nov 21 11:53:28 2000
+++ mercury_il.il Mon Dec 4 21:37:56 2000
@@ -0,0 +1,536 @@
+
+// .module 'generic.dll'
+
+// .assembly extern mscorlib { }
+
+.assembly extern mercury { }
+
+.assembly extern 'mercury_cpp' { }
+
+.assembly extern 'mercury.io' { }
+
+.class public 'mercury.init' {
+ .method static default void init_runtime() {
+ call void mercury.io::init_state_2_p_0()
+ }
+}
+
+
+.class public temphack {
+
+.method static default int32
+get_ftn_ptr_mercury__private_builtin__do_compare__typeclass_info_1_0() {
+ ldftn void ['mercury'] 'mercury'.'private_builtin__c_code'::
+ mercury__private_builtin__do_compare__typeclass_info_1_0(
+ class System.Object[], class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__private_builtin__do_unify__typeclass_info_1_0() {
+ ldftn int32 ['mercury'] 'mercury'.'private_builtin__c_code'::
+ mercury__private_builtin__do_unify__typeclass_info_1_0(
+ class System.Object[], class System.Object,
+ class System.Object)
+ ret
+}
+
+.method static default int32
+get_ftn_ptr_mercury__private_builtin__do_compare__base_typeclass_info_1_0() {
+ ldftn void ['mercury'] 'mercury'.'private_builtin__c_code'::
+ mercury__private_builtin__do_compare__base_typeclass_info_1_0(
+ class System.Object[], class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__private_builtin__do_unify__base_typeclass_info_1_0() {
+ ldftn int32 ['mercury'] 'mercury'.'private_builtin__c_code'::
+ mercury__private_builtin__do_unify__base_typeclass_info_1_0(
+ class System.Object[], class System.Object,
+ class System.Object)
+ ret
+}
+
+.method static default int32
+get_ftn_ptr_mercury__private_builtin__do_compare__type_info_1_0() {
+ ldftn void ['mercury'] 'mercury'.'private_builtin__c_code'::
+ mercury__private_builtin__do_compare__type_info_1_0(
+ class System.Object[], class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__private_builtin__do_unify__type_info_1_0() {
+ ldftn int32 ['mercury'] 'mercury'.'private_builtin__c_code'::
+ mercury__private_builtin__do_unify__type_info_1_0(
+ class System.Object[], class System.Object,
+ class System.Object)
+ ret
+}
+
+.method static default int32
+get_ftn_ptr_mercury__private_builtin__do_compare__type_ctor_info_1_0() {
+ ldftn void ['mercury'] 'mercury'.'private_builtin__c_code'::
+ mercury__private_builtin__do_compare__type_ctor_info_1_0(
+ class System.Object[], class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__private_builtin__do_unify__type_ctor_info_1_0() {
+ ldftn int32 ['mercury'] 'mercury'.'private_builtin__c_code'::
+ mercury__private_builtin__do_unify__type_ctor_info_1_0(
+ class System.Object[], class System.Object,
+ class System.Object)
+ ret
+}
+
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_compare__pred_0_0() {
+ ldftn void ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_compare__pred_0_0(
+ class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_unify__pred_0_0() {
+ ldftn int32 ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_unify__pred_0_0(
+ class System.Object, class System.Object)
+ ret
+}
+
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_compare__func_0_0() {
+ ldftn void ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_compare__func_0_0(
+ class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_unify__func_0_0() {
+ ldftn int32 ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_unify__func_0_0(
+ class System.Object, class System.Object)
+ ret
+}
+
+
+
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_compare__float_0_0() {
+ ldftn void ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_compare__float_0_0(
+ class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_unify__float_0_0() {
+ ldftn int32 ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_unify__float_0_0(
+ class System.Object, class System.Object)
+ ret
+}
+
+
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_compare__void_0_0() {
+ ldftn void ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_compare__void_0_0(
+ class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_unify__void_0_0() {
+ ldftn int32 ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_unify__void_0_0(
+ class System.Object, class System.Object)
+ ret
+}
+
+
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_compare__c_pointer_0_0() {
+ ldftn void ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_compare__c_pointer_0_0(
+ class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_unify__c_pointer_0_0() {
+ ldftn int32 ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_unify__c_pointer_0_0(
+ class System.Object, class System.Object)
+ ret
+}
+
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_compare__string_0_0() {
+ ldftn void ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_compare__string_0_0(
+ class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_unify__string_0_0() {
+ ldftn int32 ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_unify__string_0_0(
+ class System.Object, class System.Object)
+ ret
+}
+
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_compare__character_0_0() {
+ ldftn void ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_compare__character_0_0(
+ class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_unify__character_0_0() {
+ ldftn int32 ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_unify__character_0_0(
+ class System.Object, class System.Object)
+ ret
+}
+
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_compare__int_0_0() {
+ ldftn void ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_compare__int_0_0(
+ class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__builtin__do_unify__int_0_0() {
+ ldftn int32 ['mercury'] 'mercury'.'builtin__c_code'::
+ mercury__builtin__do_unify__int_0_0(
+ class System.Object, class System.Object)
+ ret
+}
+
+.method static default int32
+get_ftn_ptr_mercury__array__do_compare__array_1_0() {
+ ldftn void ['mercury'] 'mercury'.'array__c_code'::
+ mercury__array__do_compare__array_1_0(
+ class System.Object[], class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__array__do_unify__array_1_0() {
+ ldftn int32 ['mercury'] 'mercury'.'array__c_code'::
+ mercury__array__do_unify__array_1_0(
+ class System.Object[], class System.Object,
+ class System.Object)
+ ret
+}
+
+.method static default int32
+get_ftn_ptr_mercury__std_util__do_compare__type_desc_0_0() {
+ ldftn void ['mercury'] 'mercury'.'std_util__c_code'::
+ mercury__std_util__do_compare__type_desc_0_0(
+ class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__std_util__do_unify__type_desc_0_0() {
+ ldftn int32 ['mercury'] 'mercury'.'std_util__c_code'::
+ mercury__std_util__do_unify__type_desc_0_0(
+ class System.Object, class System.Object)
+ ret
+}
+
+.method static default int32
+get_ftn_ptr_mercury__std_util__do_compare__univ_0_0() {
+ ldftn void ['mercury'] 'mercury'.'std_util__c_code'::
+ mercury__std_util__do_compare__univ_0_0(
+ class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+.method static default int32
+get_ftn_ptr_mercury__std_util__do_unify__univ_0_0() {
+ ldftn int32 ['mercury'] 'mercury'.'std_util__c_code'::
+ mercury__std_util__do_unify__univ_0_0(
+ class System.Object, class System.Object)
+ ret
+}
+
+}
+
+.class public boxedint {
+.field public int32 val
+.method default void .ctor(int32)
+{
+ ldarg.0
+ call instance void System.Object::.ctor()
+ ldarg.0
+ ldarg.1
+ stfld int32 boxedint::val
+ ret
+}
+
+}
+
+.class public boxedfloat {
+.field public float64 val
+.method default void .ctor(float64)
+{
+ ldarg.0
+ call instance void System.Object::.ctor()
+ ldarg.0
+ ldarg.1
+ stfld float64 boxedfloat::val
+ ret
+}
+
+}
+
+.class public convert_imp {
+
+.method static default class System.Object ToObject(int32 ival)
+{
+ ldarg ival
+ newobj instance void boxedint::.ctor(int32)
+ ret
+}
+
+.method static default int32 ToInt32(class System.Object obj)
+{
+ ldarg obj
+ ldnull
+ beq l1
+
+ ldarg obj
+ isinst class boxedint
+ ldfld int32 boxedint::val
+ ret
+l1:
+ ldc.i4 42
+ ret
+}
+
+.method static default float64 ToFloat64(class System.Object obj)
+{
+ ldarg obj
+ ldnull
+ beq l1
+
+ ldarg obj
+ isinst class boxedfloat
+ ldfld float64 boxedfloat::val
+ ret
+l1:
+ ldc.i4 42
+ ret
+}
+
+
+}
+
+.class public generic {
+
+.method static default int32 generic_call2(class System.Object,
+ class System.Object, class System.Object)
+{
+ ldarg.1
+ ldarg.2
+ ldarg.0
+ call int32 convert_imp::ToInt32(class System.Object)
+ calli int32 (class System.Object, class System.Object)
+ ret
+}
+
+
+.method static default int32 generic_call3(class System.Object,
+ class System.Object, class System.Object, class System.Object)
+{
+ ldarg.1
+ ldarg.2
+ ldarg.3
+ ldarg.0
+ call int32 convert_imp::ToInt32(class System.Object)
+ calli int32 (class System.Object, class System.Object, class System.Object)
+ ret
+}
+
+.method static default int32 generic_call4(class System.Object,
+ class System.Object, class System.Object, class System.Object, class System.Object)
+{
+ ldarg.1
+ ldarg.2
+ ldarg.3
+ ldarg 4
+ ldarg.0
+ call int32 convert_imp::ToInt32(class System.Object)
+ calli int32 (class System.Object, class System.Object, class System.Object, class System.Object)
+ ret
+}
+
+.method static default int32 generic_call5(class System.Object,
+ class System.Object, class System.Object, class System.Object, class System.Object, class System.Object)
+{
+ ldarg.1
+ ldarg.2
+ ldarg.3
+ ldarg 4
+ ldarg 5
+ ldarg.0
+ call int32 convert_imp::ToInt32(class System.Object)
+ calli int32 (class System.Object, class System.Object, class System.Object, class System.Object, class System.Object)
+ ret
+}
+
+.method static default int32 generic_call6(class System.Object,
+ class System.Object, class System.Object, class System.Object, class System.Object, class System.Object, class System.Object)
+{
+ ldarg.1
+ ldarg.2
+ ldarg.3
+ ldarg 4
+ ldarg 5
+ ldarg 6
+ ldarg.0
+ call int32 convert_imp::ToInt32(class System.Object)
+ calli int32 (class System.Object, class System.Object, class System.Object, class System.Object, class System.Object, class System.Object)
+ ret
+}
+
+
+.method static default int32 generic_call7(class System.Object,
+ class System.Object, class System.Object, class System.Object, class System.Object, class System.Object, class System.Object, class System.Object)
+{
+ ldarg.1
+ ldarg.2
+ ldarg.3
+ ldarg 4
+ ldarg 5
+ ldarg 6
+ ldarg 7
+ ldarg.0
+ call int32 convert_imp::ToInt32(class System.Object)
+ calli int32 (class System.Object, class System.Object, class System.Object, class System.Object, class System.Object, class System.Object, class System.Object)
+ ret
+}
+
+.method static default void generic_res_call3(class System.Object,
+ class System.Object[]&, class System.Object, class System.Object)
+{
+ ldarg.1
+ ldarg.2
+ ldarg.3
+ ldarg.0
+ call int32 convert_imp::ToInt32(class System.Object)
+ calli void (class System.Object[]&, class System.Object, class System.Object)
+ ret
+}
+
+.method static default void generic_res_call4(class System.Object,
+ class System.Object, class System.Object[]&, class System.Object,
+ class System.Object)
+{
+ ldarg.1
+ ldarg.2
+ ldarg.3
+ ldarg 4
+ ldarg.0
+ call int32 convert_imp::ToInt32(class System.Object)
+ calli void (class System.Object, class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+
+.method static default void generic_res_call5(class System.Object,
+ class System.Object, class System.Object, class System.Object[]&,
+ class System.Object, class System.Object)
+{
+ ldarg.1
+ ldarg.2
+ ldarg.3
+ ldarg 4
+ ldarg 5
+ ldarg.0
+ call int32 convert_imp::ToInt32(class System.Object)
+ calli void (class System.Object,
+ class System.Object, class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+
+.method static default void generic_res_call6(class System.Object,
+ class System.Object, class System.Object, class System.Object,
+ class System.Object[]&, class System.Object, class System.Object)
+{
+ ldarg.1
+ ldarg.2
+ ldarg.3
+ ldarg 4
+ ldarg 5
+ ldarg 6
+ ldarg.0
+ call int32 convert_imp::ToInt32(class System.Object)
+ calli void (class System.Object, class System.Object,
+ class System.Object, class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+
+.method static default void generic_res_call7(class System.Object,
+ class System.Object, class System.Object, class System.Object,
+ class System.Object, class System.Object[]&, class System.Object,
+ class System.Object)
+{
+ ldarg.1
+ ldarg.2
+ ldarg.3
+ ldarg 4
+ ldarg 5
+ ldarg 6
+ ldarg 7
+ ldarg.0
+ call int32 convert_imp::ToInt32(class System.Object)
+ calli void (class System.Object, class System.Object,
+ class System.Object,
+ class System.Object, class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+
+.method static default void generic_res_call8(class System.Object,
+ class System.Object, class System.Object, class System.Object,
+ class System.Object,
+ class System.Object, class System.Object[]&, class System.Object,
+ class System.Object)
+{
+ ldarg.1
+ ldarg.2
+ ldarg.3
+ ldarg 4
+ ldarg 5
+ ldarg 6
+ ldarg 7
+ ldarg 8
+ ldarg.0
+ call int32 convert_imp::ToInt32(class System.Object)
+ calli void (class System.Object, class System.Object,
+ class System.Object, class System.Object,
+ class System.Object, class System.Object[]&,
+ class System.Object, class System.Object)
+ ret
+}
+
+
+}
+
+
Index: scripts/Mmake.rules
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/Mmake.rules,v
retrieving revision 1.84
diff -u -r1.84 Mmake.rules
--- scripts/Mmake.rules 2000/11/17 07:34:16 1.84
+++ scripts/Mmake.rules 2000/12/01 00:35:30
@@ -22,7 +22,7 @@
.i .s .pic_s \
.ql .pl \
.rlo \
- .il
+ .il .dll .exe .cpp
#-----------------------------------------------------------------------------#
#
@@ -180,9 +180,19 @@
# .NET back-end
$(ils_subdir)%.il : %.m
- rm -f $(ils_subdir)$*.c
+ rm -f $(ils_subdir)$*.il
$(MCG) $(ALL_GRADEFLAGS) $(ALL_MCGFLAGS) --il-only $< > $*.err 2>&1
+$(os_subdir)%.dll : %.cpp
+ rm -f $(os_subdir)$*.dll
+ $(MSCL) -com+$(MSCL_NOASM) -I$(MERC_C_INCL_DIR) \
+ -I$(MERC_DLL_DIR) $(ALL_MSCLFLAGS) $< -link -noentry \
+ -dll $(MSCL_LIBS) -out:$@
+
+$(os_subdir)%.dll : %.il
+ rm -f $(os_subdir)$*.dll
+ $(MSILASM) $(ALL_MSILASMFLAGS) /dll /quiet /OUT=$@ $<
+
# If we are removing the .c files, we need to tell Make that we're
# generating the .$O files directly from the .m files, but
# in order to avoid remaking the .c files if they're already there,
@@ -250,6 +260,7 @@
.c.i:
$(MGNUC) $(ALL_GRADEFLAGS) $(ALL_MGNUCFLAGS) -E $< > $@
+
#-----------------------------------------------------------------------------#
#
# Rules for compiling C files in a subdirectory.
@@ -278,6 +289,28 @@
$(MGNUC) $(ALL_GRADEFLAGS) $(ALL_MGNUCFLAGS) -E $< > $@
endif # $(cs_subdir) != ""
+
+#-----------------------------------------------------------------------------#
+#
+# Rules for compiling IL files in the user's source directory.
+#
+
+ifneq ("$(ils_subdir)","")
+
+.il.dll:
+ $(MSILASM) $(ALL_MSILASMFLAGS) /dll /OUT=$@ $<
+
+.il.exe:
+ $(MSILASM) $(ALL_MSILASMFLAGS) /OUT=$@ $<
+ cp default.cfg $*.cfg
+
+.cpp.dll:
+ $(MSCL) -com+($MSCL_NOASM) -I$(MERCURY_LIBRARY_PATH) $< -link -noentry -dll $(MSCL_LIBS) -out:$@
+
+.cpp.exe:
+ $(MSCL) -com+($MSCL_NOASM) -I$(MERCURY_LIBRARY_PATH) $< -link -entry:main $(MSCL_LIBS) -out:$@
+
+endif # $(ils_subdir) != ""
#-----------------------------------------------------------------------------#
#
Index: scripts/Mmake.vars.in
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/Mmake.vars.in,v
retrieving revision 1.37
diff -u -r1.37 Mmake.vars.in
--- scripts/Mmake.vars.in 2000/11/17 07:34:17 1.37
+++ scripts/Mmake.vars.in 2000/12/04 12:17:29
@@ -130,6 +130,26 @@
CFLAGS =
EXTRA_CFLAGS =
+MSCL = cl
+ALL_MSCLFLAGS = $(MSCLFLAGS) $(EXTRA_MSCLFLAGS) $(TARGET_MSCLFLAGS) \
+ $(LIB_MSCLFLAGS) $(ALL_CFLAGS)
+MSCLFLAGS =
+EXTRA_MSCLFLAGS =
+LIB_MSCLFLAGS = $(patsubst %,-I %,$(EXTRA_C_INCL_DIRS))
+MSCL_NOASM =
+MSNETSDKDIR = @MSNETSDKDIR@
+MSCL_LIBS = $(MSNETSDKDIR)/Lib/mscoree.lib \
+ $(MSNETSDKDIR)/Lib/kernel32.lib
+MERC_C_INCL_DIR = @LIBDIR@/inc
+MERC_DLL_DIR = @LIBDIR@/inc
+
+MSILASM = @ILASM@
+ALL_MSILASMFLAGS= $(MSILASMFLAGS) $(EXTRA_MSILASMFLAGS) $(TARGET_MSILASMFLAGS) \
+ $(LIB_MSILASMFLAGS)
+MSILASMFLAGS =
+EXTRA_MSILASMFLAGS =
+LIB_MSILASMFLAGS= $(patsubst %,-I %,$(EXTRA_C_INCL_DIRS))
+
ML = ml
ALL_MLFLAGS = $(MLFLAGS) $(EXTRA_MLFLAGS) $(TARGET_MLFLAGS) $(LIB_MLFLAGS)
MLFLAGS = $(EXTRA_MLFLAGS)
@@ -322,6 +342,16 @@
$(origin EXTRA_LIBGRADES-$*)))
maybe-base-EXTRA_LIBGRADES- = $(EXTRA_LIBGRADES-$*)
maybe-base-EXTRA_LIBGRADES-undefined =
+
+TARGET_MSCLFLAGS = \
+ $(maybe-base-MSCLFLAGS-$(findstring undefined,$(origin MSCLFLAGS-$*)))
+maybe-base-MSCLFLAGS- = $(MSCLFLAGS-$*)
+maybe-base-MSCLFLAGS-undefined =
+
+TARGET_MSILASMFLAGS = \
+ $(maybe-base-MSILASMFLAGS-$(findstring undefined,$(origin MSILASMFLAGS-$*)))
+maybe-base-MSILASMFLAGS- = $(MSILASMFLAGS-$*)
+maybe-base-MSILASMFLAGS-undefined =
# Support for compiling Mercury programs with Prolog will probably be
# dropped one of these days, so it's probably not worth bothering with these.
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
trd at cs.mu.oz.au #
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list