[m-rev.] diff: today's stdlib changes for C#
Peter Wang
novalazy at gmail.com
Fri Oct 15 16:54:57 AEDT 2010
Branches: main
library/io.m:
Always use UTF-8 encoding without byte-order marks, for text streams.
Do not use `System.Encoding.Default', which could be an 8-bit character
encoding or UTF-8 with BOM.
Rename `ML_file_encoding_kind' to `ML_line_ending_kind'.
Delete unused predicate `io.write_bytes_2'.
library/rtti_implementation.m:
library/type_desc.m:
Implement comparison of pseudo_type_infos.
Implement deconstruction of foreign enums.
library/benchmarking.m:
Partially implement `report_stats' in C#, and make
`report_full_memory_stats' not abort.
library/string.m:
Make `c_pointer_to_string' handle null pointers in C#.
Implement C# version of `semidet_from_rev_char_list'.
library/thread.m:
Add C# implementations of `can_spawn' and `yield'.
library/dir.m:
Delete unneeded foreign_exports.
diff --git a/library/benchmarking.m b/library/benchmarking.m
index c3cf4ef..0f381f3 100644
--- a/library/benchmarking.m
+++ b/library/benchmarking.m
@@ -172,6 +172,20 @@ extern void ML_report_full_memory_stats(void);
#endif
").
+:- pragma foreign_proc("C#",
+ report_stats,
+ [may_call_mercury, terminates],
+"
+ ML_report_stats();
+").
+
+:- pragma foreign_proc("C#",
+ report_full_memory_stats,
+ [will_not_call_mercury],
+"
+ ML_report_full_memory_stats();
+").
+
:- pragma foreign_proc("Java",
report_stats,
[may_call_mercury, terminates],
@@ -695,6 +709,58 @@ ML_memory_profile_compare_final(const void *i1, const void *i2)
#endif /* MR_MPROF_PROFILE_MEMORY */
").
+:- pragma foreign_code("C#",
+"
+private static double user_time_at_start
+ = System.Diagnostics.Process.GetCurrentProcess().UserProcessorTime
+ .TotalSeconds;
+private static double user_time_at_last_stat;
+
+private static long real_time_at_start
+ = real_time_at_last_stat = System.DateTime.Now.Ticks;
+private static long real_time_at_last_stat;
+
+private static void
+ML_report_stats()
+{
+ double user_time_at_prev_stat = user_time_at_last_stat;
+ user_time_at_last_stat = System.Diagnostics.Process.GetCurrentProcess()
+ .UserProcessorTime.TotalSeconds;
+
+ long real_time_at_prev_stat = real_time_at_last_stat;
+ real_time_at_last_stat = System.DateTime.Now.Ticks;
+
+ System.Console.WriteLine(System.String.Format(
+ ""[User time: +{0:F2}s, {1:F2}s Real time: +{2:F2}s, {3:F2}s]"",
+ (user_time_at_last_stat - user_time_at_prev_stat),
+ (user_time_at_last_stat - user_time_at_start),
+ ((real_time_at_last_stat - real_time_at_prev_stat)
+ / (double) System.TimeSpan.TicksPerSecond),
+ ((real_time_at_last_stat - real_time_at_start)
+ / (double) System.TimeSpan.TicksPerSecond)
+ ));
+
+ /*
+ ** XXX At this point there should be a whole bunch of memory usage
+ ** statistics.
+ */
+}
+
+private static void
+ML_report_full_memory_stats()
+{
+ /*
+ ** XXX The support for this predicate is even worse. Since we don't have
+ ** access to memory usage statistics, all you get here is an apology.
+ ** But at least it doesn't just crash with an error.
+ */
+
+ System.Console.Error.WriteLine(
+ ""Sorry, report_full_memory_stats is not yet "" +
+ ""implemented for the C# back-end."");
+}
+").
+
:- pragma foreign_code("Java",
"
private static int user_time_at_start = 0;
@@ -882,6 +948,8 @@ repeat(N) :-
:- impure pred get_user_cpu_milliseconds(int::out) is det.
+:- pragma foreign_export("C#", get_user_cpu_milliseconds(out),
+ "ML_get_user_cpu_milliseconds").
:- pragma foreign_export("Java", get_user_cpu_milliseconds(out),
"ML_get_user_cpu_milliseconds").
@@ -892,17 +960,16 @@ repeat(N) :-
Time = MR_get_user_cpu_milliseconds();
").
-% XXX Can't seem to get this to work -- perhaps Diagnostics isn't yet
-% available in Beta 1 of the .NET framework.
-% :- pragma foreign_proc("MC++",
-% get_user_cpu_milliseconds(_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.
-% Time = (int) (1000 * System::Diagnostics::Counter::GetElapsed());
-% ").
+:- pragma foreign_proc("C#",
+ get_user_cpu_milliseconds(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.
+ Time = (int) System.Diagnostics.Process.GetCurrentProcess()
+ .UserProcessorTime.TotalMilliseconds;
+").
:- pragma foreign_proc("Java",
get_user_cpu_milliseconds(Time::out),
@@ -949,21 +1016,13 @@ repeat(N) :-
"
ML_benchmarking_dummy_word = (MR_Word) X;
").
-/*
-** To prevent the MC++ compiler from optimizing the benchmark code away,
-** we assign the benchmark output to a volatile static variable.
-** XXX at least, we should do this but it doesn't seem to work.
-*/
-/*
-:- pragma foreign_proc("MC++",
- do_nothing(X::in),
+
+:- pragma foreign_proc("C#",
+ do_nothing(_X::in),
[will_not_call_mercury, thread_safe],
"
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
- static volatile MR_Word ML_benchmarking_dummy_word;
- ML_benchmarking_dummy_word = (MR_Word) X;
+ /* XXX do we need to assign X to something? */
").
-*/
:- pragma foreign_code("Java",
"
diff --git a/library/dir.m b/library/dir.m
index 51a5805..bf23ee2 100644
--- a/library/dir.m
+++ b/library/dir.m
@@ -1759,15 +1759,6 @@ dir.read_first_entry(Dir, Result, !IO) :-
:- pragma foreign_export("C",
make_win32_dir_open_result_ok(in, in, out, di, uo),
"ML_make_win32_dir_open_result_ok").
-:- pragma foreign_export("IL",
- make_win32_dir_open_result_ok(in, in, out, di, uo),
- "ML_make_win32_dir_open_result_ok").
-:- pragma foreign_export("C#",
- make_win32_dir_open_result_ok(in, in, out, di, uo),
- "ML_make_win32_dir_open_result_ok").
-:- pragma foreign_export("Java",
- make_win32_dir_open_result_ok(in, in, out, di, uo),
- "ML_make_win32_dir_open_result_ok").
make_win32_dir_open_result_ok(Dir, FirstFilePtr, Result, !IO) :-
FirstFile0 = copy_c_string(FirstFilePtr),
diff --git a/library/io.m b/library/io.m
index 83acd9d..f6f244a 100644
--- a/library/io.m
+++ b/library/io.m
@@ -1762,8 +1762,13 @@
// by an environment variable. (This might require moving
// the code which initializes mercury_stdin, etc.)
//
- static ML_file_encoding_kind ML_default_text_encoding =
- ML_file_encoding_kind.ML_OS_text_encoding;
+ static readonly ML_line_ending_kind ML_default_line_ending =
+ ML_line_ending_kind.ML_OS_line_ending;
+
+ // Assume UTF-8 encoding on files. When writing a file, don't emit
+ // a byte order mark.
+ static readonly System.Text.Encoding text_encoding =
+ new System.Text.UTF8Encoding(false);
").
:- pragma foreign_code("Java",
@@ -5696,7 +5701,6 @@ MercuryFilePtr mercury_open(const char *filename, const char *openmode);
void mercury_io_error(MercuryFilePtr mf, const char *format, ...);
void mercury_output_error(MercuryFilePtr mf);
void mercury_print_string(MercuryFilePtr mf, const char *s);
-void mercury_print_binary_string(MercuryFilePtr mf, const char *s);
int mercury_getc(MercuryFilePtr mf);
void mercury_close(MercuryFilePtr mf);
int ML_fprintf(MercuryFilePtr mf, const char *format, ...);
@@ -5704,17 +5708,11 @@ int ML_fprintf(MercuryFilePtr mf, const char *format, ...);
:- pragma foreign_code("C#", "
- public enum ML_file_encoding_kind {
- ML_OS_text_encoding, // file stores characters,
- // using the operating system's
- // default encoding, and OS's
- // usual line-ending convention
- // (e.g. CR-LF for DOS/Windows).
+ public enum ML_line_ending_kind {
+ ML_OS_line_ending, // file uses the usual line-ending convention
+ // for the OS (e.g. CR-LF for DOS/Windows).
- ML_Unix_text_encoding, // file stores characters,
- // using the operating system's
- // default encoding, but with the
- // Unix line-ending convention.
+ ML_Unix_line_ending, // file uses the Unix line-encoding convention.
ML_raw_binary // file stores bytes
};
@@ -5733,7 +5731,7 @@ int ML_fprintf(MercuryFilePtr mf, const char *format, ...);
// the next character or byte to read,
// or -1 if no putback char/byte is stored
- public ML_file_encoding_kind file_encoding;
+ public ML_line_ending_kind line_ending;
// DOS, Unix, or raw binary
public int line_number;
@@ -6363,14 +6361,14 @@ mercury_next_stream_id(void)
static MR_MercuryFileStruct
mercury_file_init(System.IO.Stream stream,
System.IO.TextReader reader, System.IO.TextWriter writer,
- ML_file_encoding_kind file_encoding)
+ ML_line_ending_kind line_ending)
{
MR_MercuryFileStruct mf = new MR_MercuryFileStruct();
mf.stream = stream;
mf.reader = reader;
mf.putback = -1;
mf.writer = writer;
- mf.file_encoding = file_encoding;
+ mf.line_ending = line_ending;
mf.line_number = 1;
mf.id = ML_next_stream_id++;
return mf;
@@ -6383,21 +6381,21 @@ mercury_file_init(System.IO.Stream stream,
public static MR_MercuryFileStruct mercury_stdin =
mercury_file_init(System.Console.OpenStandardInput(),
- System.Console.In, null, ML_default_text_encoding);
+ System.Console.In, null, ML_default_line_ending);
public static MR_MercuryFileStruct mercury_stdout =
mercury_file_init(System.Console.OpenStandardOutput(),
- null, System.Console.Out, ML_default_text_encoding);
+ null, System.Console.Out, ML_default_line_ending);
public static MR_MercuryFileStruct mercury_stderr =
mercury_file_init(System.Console.OpenStandardError(),
- null, System.Console.Error, ML_default_text_encoding);
+ null, System.Console.Error, ML_default_line_ending);
// XXX should we use BufferedStreams here?
public static MR_MercuryFileStruct mercury_stdin_binary =
mercury_file_init(System.Console.OpenStandardInput(),
- System.Console.In, null, ML_file_encoding_kind.ML_raw_binary);
+ System.Console.In, null, ML_line_ending_kind.ML_raw_binary);
public static MR_MercuryFileStruct mercury_stdout_binary =
mercury_file_init(System.Console.OpenStandardOutput(),
- null, System.Console.Out, ML_file_encoding_kind.ML_raw_binary);
+ null, System.Console.Out, ML_line_ending_kind.ML_raw_binary);
// Note: these are set again in io.init_state.
public static MR_MercuryFileStruct mercury_current_text_input =
@@ -6840,7 +6838,7 @@ mercury_open(const char *filename, const char *openmode)
public static
MR_MercuryFileStruct mercury_open(string filename, string openmode,
- ML_file_encoding_kind file_encoding)
+ ML_line_ending_kind line_ending)
{
System.IO.FileMode mode;
System.IO.FileAccess access;
@@ -6889,7 +6887,7 @@ MR_MercuryFileStruct mercury_open(string filename, string openmode,
// we initialize the `reader' and `writer' fields to null;
// they will be filled in later if they are needed.
return mercury_file_init(new System.IO.BufferedStream(stream),
- null, null, file_encoding);
+ null, null, line_ending);
}
}
@@ -6966,31 +6964,13 @@ mercury_print_string(MercuryFilePtr mf, const char *s)
public static void
mercury_print_string(MR_MercuryFileStruct mf, string s)
{
- //
- // For the .NET back-end, strings are represented as Unicode. Text output
- // streams (which may be connected to text files, or to the console)
- // require a byte stream. This raises the question: how should we convert
- // from Unicode to the byte sequence?
- //
- // We leave this up to the system, by just using the TextWriter associated
- // with the file. For the console, this will be System.Console.Out, which
- // will use whatever encoding is appropriate for the console. For a file,
- // the TextWriter will use the System.Encoding.Default encoding, which
- // will normally be an 8-bit national character set. If the Unicode string
- // contains characters which can't be represented in this set, then the
- // encoder will throw an exception.
- //
- // For files, we construct the TextWriter here, rather than at file open
- // time, so that we don't try to construct TextWriters for input streams.
-
if (mf.writer == null) {
- mf.writer = new System.IO.StreamWriter(mf.stream,
- System.Text.Encoding.Default);
+ mf.writer = new System.IO.StreamWriter(mf.stream, text_encoding);
}
- switch (mf.file_encoding) {
- case ML_file_encoding_kind.ML_raw_binary:
- case ML_file_encoding_kind.ML_Unix_text_encoding:
+ switch (mf.line_ending) {
+ case ML_line_ending_kind.ML_raw_binary:
+ case ML_line_ending_kind.ML_Unix_line_ending:
mf.writer.Write(s);
for (int i = 0; i < s.Length; i++) {
if (s[i] == '\\n') {
@@ -6998,7 +6978,7 @@ mercury_print_string(MR_MercuryFileStruct mf, string s)
}
}
break;
- case ML_file_encoding_kind.ML_OS_text_encoding:
+ case ML_line_ending_kind.ML_OS_line_ending:
// We can't just use the System.TextWriter.Write(String) method,
// since that method doesn't convert newline characters to the
// system's newline convention (e.g. CR-LF on Windows).
@@ -7021,18 +7001,6 @@ mercury_print_string(MR_MercuryFileStruct mf, string s)
:- pragma foreign_code("C", "
-void
-mercury_print_binary_string(MercuryFilePtr mf, const char *s)
-{
- if (ML_fprintf(mf, ""%s"", s) < 0) {
- mercury_output_error(mf);
- }
-}
-
-").
-
-:- pragma foreign_code("C", "
-
int
mercury_getc(MercuryFilePtr mf)
{
@@ -7047,63 +7015,6 @@ mercury_getc(MercuryFilePtr mf)
:- pragma foreign_code("C#", "
-public static void
-mercury_print_binary_string(MR_MercuryFileStruct mf, string s)
-{
- // sanity check
- if (mf.file_encoding != ML_file_encoding_kind.ML_raw_binary) {
- runtime.Errors.fatal_error(
- ""mercury_print_binary_string: file encoding is not raw binary"");
- }
-
- //
- // For the .NET back-end, strings are represented as Unicode.
- // Binary files are stored as byte sequences. This raises the
- // question: how should we convert from Unicode to the byte sequence?
- //
- // If the string that we are writing is a genuine character string,
- // then probably the best thing to do is the same thing that we do
- // for mercury_print_string(): do the conversion using
- // the System.Encoding.Default encoding, which is the encoding
- // corresponding to the system's code page (character set), which
- // will normally be an 8-bit national character set. If the Unicode
- // string contains characters which can't be represented in this set,
- // then the encoder will throw an exception.
- //
- // On the other hand, if the string contains binary values which
- // are supposed to be used only for their binary value -- which may
- // be the case if it was constructed using characters which have
- // been obtained using `enum.from_int' (i.e. the reverse mode of
- // `char.to_int'), then probably it would be better to just
- // take the lower 8 bits of the Unicode values, and throw an
- // exception if any of the other bits are set.
- //
- // The documentation for io.write_bytes doesn't make it clear
- // which of these is the case. It says ``the bytes are taken
- // from a string'', but it doesn't say how. I will assume
- // that it means the bottom 8 bits of the Unicode value,
- // just like io.write_byte takes the byte from the bottom 8 bits
- // of the int value.
-
-// XXX possible alternative implementation.
-// byte[] byte_array = System.Text.Encoding.Default().GetBytes(s);
-
- int len = s.Length;
- byte[] byte_array = new byte[len];
- for (int i = 0; i < len; i++) {
- byte_array[i] = (byte) s[i];
- if (byte_array[i] != s[i]) {
- runtime.Errors.SORRY(
- ""write_bytes: Unicode char does not fit in a byte"");
- }
- }
- mf.stream.Write(byte_array, 0, byte_array.Length);
-}
-
-").
-
-:- pragma foreign_code("C#", "
-
// Read in a character. This means reading in one or more bytes,
// converting the bytes from the system's default encoding to Unicode,
// and possibly converting CR-LF to newline. Returns -1 on error or EOF.
@@ -7125,19 +7036,18 @@ mercury_getc(MR_MercuryFileStruct mf)
}
if (mf.reader == null) {
- mf.reader = new System.IO.StreamReader(mf.stream,
- System.Text.Encoding.Default);
+ mf.reader = new System.IO.StreamReader(mf.stream, text_encoding);
}
c = mf.reader.Read();
- switch (mf.file_encoding) {
- case ML_file_encoding_kind.ML_raw_binary:
- case ML_file_encoding_kind.ML_Unix_text_encoding:
+ switch (mf.line_ending) {
+ case ML_line_ending_kind.ML_raw_binary:
+ case ML_line_ending_kind.ML_Unix_line_ending:
if (c == '\\n') {
mf.line_number++;
}
break;
- case ML_file_encoding_kind.ML_OS_text_encoding:
+ case ML_line_ending_kind.ML_OS_line_ending:
// First, check if the character we've read matches
// System.Environment.NewLine.
// We assume that System.Environment.NewLine is non-null
@@ -7684,22 +7594,23 @@ io.write_bitmap(Bitmap, Start, NumBytes, !IO) :-
:- pragma foreign_proc("C#",
io.write_char(Character::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates,
+ may_not_duplicate],
"
/* See mercury_output_string() for comments */
if (io.mercury_current_text_output.writer == null) {
io.mercury_current_text_output.writer =
new System.IO.StreamWriter(io.mercury_current_text_output.stream,
- System.Text.Encoding.Default);
+ text_encoding);
}
System.IO.TextWriter w = io.mercury_current_text_output.writer;
if (Character == '\\n') {
- switch (io.mercury_current_text_output.file_encoding) {
- case io.ML_file_encoding_kind.ML_raw_binary:
- case io.ML_file_encoding_kind.ML_Unix_text_encoding:
+ switch (io.mercury_current_text_output.line_ending) {
+ case io.ML_line_ending_kind.ML_raw_binary:
+ case io.ML_line_ending_kind.ML_Unix_line_ending:
w.Write(Character);
break;
- case io.ML_file_encoding_kind.ML_OS_text_encoding:
+ case io.ML_line_ending_kind.ML_OS_line_ending:
w.WriteLine("""");
break;
}
@@ -7985,16 +7896,6 @@ io.write_byte(binary_output_stream(Stream), Byte, !IO) :-
MR_update_io(IO0, IO);
").
-:- pred io.write_bytes_2(io.stream::in, string::in, io::di, io::uo) is det.
-:- pragma foreign_proc("C",
- io.write_bytes_2(Stream::in, Message::in, IO0::di, IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
- does_not_affect_liveness, no_sharing],
-"
- mercury_print_binary_string(Stream, Message);
- MR_update_io(IO0, IO);
-").
-
io.write_bitmap(binary_output_stream(Stream), Bitmap, !IO) :-
( NumBytes = Bitmap ^ num_bytes ->
io.do_write_bitmap(Stream, Bitmap, 0, NumBytes, !IO)
@@ -8081,22 +7982,23 @@ io.flush_binary_output(binary_output_stream(Stream), !IO) :-
:- pragma foreign_proc("C#",
io.write_char_2(Stream::in, Character::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
+ [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates,
+ may_not_duplicate],
"
io.MR_MercuryFileStruct stream = Stream;
/* See mercury_output_string() for comments */
if (stream.writer == null) {
stream.writer = new System.IO.StreamWriter(stream.stream,
- System.Text.Encoding.Default);
+ text_encoding);
}
System.IO.TextWriter w = stream.writer;
if (Character == '\\n') {
- switch (stream.file_encoding) {
- case io.ML_file_encoding_kind.ML_raw_binary:
- case io.ML_file_encoding_kind.ML_Unix_text_encoding:
+ switch (stream.line_ending) {
+ case io.ML_line_ending_kind.ML_raw_binary:
+ case io.ML_line_ending_kind.ML_Unix_line_ending:
w.Write(Character);
break;
- case io.ML_file_encoding_kind.ML_OS_text_encoding:
+ case io.ML_line_ending_kind.ML_OS_line_ending:
w.WriteLine("""");
break;
}
@@ -8121,13 +8023,6 @@ io.flush_binary_output(binary_output_stream(Stream), !IO) :-
}").
:- pragma foreign_proc("C#",
- io.write_bytes_2(Stream::in, Message::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
-"{
- io.mercury_print_binary_string(Stream, Message);
-}").
-
-:- pragma foreign_proc("C#",
io.flush_output_2(Stream::in, _IO0::di, _IO::uo),
[may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"{
@@ -8201,13 +8096,6 @@ io.flush_binary_output(binary_output_stream(Stream), !IO) :-
").
:- pragma foreign_proc("Java",
- io.write_bytes_2(Stream::in, Message::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
-"
- ((io.MR_BinaryOutputFile) Stream).write_or_throw(Message);
-").
-
-:- pragma foreign_proc("Java",
io.flush_output_2(Stream::in, _IO0::di, _IO::uo),
[may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
"
@@ -8275,13 +8163,6 @@ io.flush_binary_output(binary_output_stream(Stream), !IO) :-
").
:- pragma foreign_proc("Erlang",
- io.write_bytes_2(Stream::in, Message::in, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, thread_safe, tabled_for_io, terminates],
-"
- mercury__io:mercury_write_string(Stream, Message)
-").
-
-:- pragma foreign_proc("Erlang",
io.flush_output_2(Stream::in, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
terminates],
@@ -9248,7 +9129,7 @@ io.set_binary_output_stream(binary_output_stream(NewStream),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
io.MR_MercuryFileStruct mf = io.mercury_open(FileName, Mode,
- io.ML_default_text_encoding);
+ io.ML_default_line_ending);
Stream = mf;
if (mf != null) {
ResultCode = 0;
@@ -9265,7 +9146,7 @@ io.set_binary_output_stream(binary_output_stream(NewStream),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
io.MR_MercuryFileStruct mf = io.mercury_open(FileName, Mode,
- io.ML_file_encoding_kind.ML_raw_binary);
+ io.ML_line_ending_kind.ML_raw_binary);
Stream = mf;
if (mf != null) {
ResultCode = 0;
diff --git a/library/rtti_implementation.m b/library/rtti_implementation.m
index c80ff33..a0a9dd9 100644
--- a/library/rtti_implementation.m
+++ b/library/rtti_implementation.m
@@ -222,6 +222,7 @@
import jmercury.runtime.DuFunctorDesc;
import jmercury.runtime.EnumFunctorDesc;
+ import jmercury.runtime.ForeignEnumFunctorDesc;
import jmercury.runtime.PseudoTypeInfo;
import jmercury.runtime.Ref;
import jmercury.runtime.TypeCtorInfo_Struct;
@@ -1251,6 +1252,109 @@ type_ctor_is_variable_arity(TypeCtorInfo) :-
; TypeCtorRep = tcr_tuple
).
+:- pred compare_pseudo_type_infos(comparison_result::out,
+ pseudo_type_info::in, pseudo_type_info::in) is det.
+
+:- pragma foreign_export("C#", compare_pseudo_type_infos(out, in, in),
+ "ML_compare_pseudo_type_infos").
+:- pragma foreign_export("Java", compare_pseudo_type_infos(out, in, in),
+ "ML_compare_pseudo_type_infos").
+
+compare_pseudo_type_infos(Res, PTI1, PTI2) :-
+ % Try to optimize a common case:
+ % If type_info addresses are equal, they must represent the same type.
+ ( same_pointer_value(PTI1, PTI2) ->
+ Res = (=)
+ ;
+ % Otherwise, we need to expand equivalence types, if any.
+ NewPTI1 = collapse_equivalences_pseudo(PTI1),
+ NewPTI2 = collapse_equivalences_pseudo(PTI2),
+
+ % Perhaps they are equal now...
+ ( same_pointer_value(NewPTI1, NewPTI2) ->
+ Res = (=)
+ ;
+ % Handle the comparison if either pseudo_type_info is a variable.
+ % Any non-variable is greater than a variable.
+ (
+ pseudo_type_info_is_variable(NewPTI1, VarNum1),
+ pseudo_type_info_is_variable(NewPTI2, VarNum2)
+ ->
+ compare(Res, VarNum1, VarNum2)
+ ;
+ pseudo_type_info_is_variable(NewPTI1, _)
+ ->
+ Res = (<)
+ ;
+ pseudo_type_info_is_variable(NewPTI2, _)
+ ->
+ Res = (>)
+ ;
+ % Otherwise find the type_ctor_infos, and compare those.
+ pseudo_type_ctor_and_args(NewPTI1, TypeCtorInfo1, Args1),
+ pseudo_type_ctor_and_args(NewPTI2, TypeCtorInfo2, Args2)
+ ->
+ compare_type_ctor_infos(ResTCI, TypeCtorInfo1, TypeCtorInfo2),
+ (
+ ResTCI = (<),
+ Res = (<)
+ ;
+ ResTCI = (>),
+ Res = (>)
+ ;
+ ResTCI = (=),
+ list.length(Args1, NumArgs1),
+ list.length(Args2, NumArgs2),
+ compare(ResNumArgs, NumArgs1, NumArgs2),
+ (
+ ResNumArgs = (<),
+ Res = (<)
+ ;
+ ResNumArgs = (>),
+ Res = (>)
+ ;
+ ResNumArgs = (=),
+ compare_pseudo_type_info_args(Res, Args1, Args2)
+ )
+ )
+ ;
+ error("compare_pseudo_type_infos")
+ )
+ )
+ ).
+
+:- pred compare_pseudo_type_info_args(comparison_result::out,
+ list(pseudo_type_info)::in, list(pseudo_type_info)::in) is det.
+
+compare_pseudo_type_info_args(Res, Args1, Args2) :-
+ (
+ Args1 = [],
+ Args2 = [],
+ Res = (=)
+ ;
+ Args1 = [H1 | T1],
+ Args2 = [H2 | T2],
+ compare_pseudo_type_infos(ResPTI, H1, H2),
+ (
+ ResPTI = (<),
+ Res = (<)
+ ;
+ ResPTI = (>),
+ Res = (>)
+ ;
+ ResPTI = (=),
+ compare_pseudo_type_info_args(Res, T1, T2)
+ )
+ ;
+ Args1 = [_ | _],
+ Args2 = [],
+ error("compare_pseudo_type_info_args: argument list mismatch")
+ ;
+ Args1 = [],
+ Args2 = [_ | _],
+ error("compare_pseudo_type_info_args: argument list mismatch")
+ ).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1265,10 +1369,8 @@ collapse_equivalences(TypeInfo) = NewTypeInfo :-
TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
(
% Look past equivalences.
- (
- TypeCtorRep = tcr_equiv_ground
- ;
- TypeCtorRep = tcr_equiv
+ ( TypeCtorRep = tcr_equiv_ground
+ ; TypeCtorRep = tcr_equiv
)
->
TypeLayout = get_type_layout(TypeCtorInfo),
@@ -1278,6 +1380,26 @@ collapse_equivalences(TypeInfo) = NewTypeInfo :-
NewTypeInfo = TypeInfo
).
+:- func collapse_equivalences_pseudo(pseudo_type_info) = pseudo_type_info.
+
+collapse_equivalences_pseudo(PTI) = NewPTI :-
+ (
+ pseudo_type_ctor_and_args(PTI, TypeCtorInfo, _Args),
+ TypeCtorRep = get_type_ctor_rep(TypeCtorInfo),
+ % Look past equivalences.
+ ( TypeCtorRep = tcr_equiv_ground
+ ; TypeCtorRep = tcr_equiv
+ )
+ ->
+ TypeLayout = get_type_layout(TypeCtorInfo),
+ EquivTypeInfo = get_layout_equiv(TypeLayout),
+ % XXX not sure this is correct
+ NewPTI0 = create_pseudo_type_info(EquivTypeInfo, PTI),
+ NewPTI = collapse_equivalences_pseudo(NewPTI0)
+ ;
+ NewPTI = PTI
+ ).
+
:- func get_layout_equiv(type_layout) = type_info.
:- pragma foreign_proc("C#",
@@ -2349,7 +2471,7 @@ deconstruct_2(Term, TypeInfo, TypeCtorInfo, TypeCtorRep, NonCanon,
ForeignEnumFunctorDesc = foreign_enum_functor_desc(TypeCtorRep,
unsafe_get_foreign_enum_value(Term), TypeFunctors),
Functor = foreign_enum_functor_name(ForeignEnumFunctorDesc),
- Ordinal = -1,
+ Ordinal = foreign_enum_functor_ordinal(ForeignEnumFunctorDesc),
Arity = 0,
Arguments = []
;
@@ -4757,15 +4879,23 @@ enum_functor_ordinal(EnumFunctorDesc) = EnumFunctorDesc ^ unsafe_index(1).
= foreign_enum_functor_desc.
:- mode foreign_enum_functor_desc(in(foreign_enum), in, in) = out is det.
-foreign_enum_functor_desc(_, Num, TypeFunctors) = ForeignEnumFunctorDesc :-
- ForeignEnumFunctorDesc = TypeFunctors ^ unsafe_index(Num).
+foreign_enum_functor_desc(_, _, _) = _ :-
+ error("foreign_enum_functor_desc").
:- pragma foreign_proc("C#",
foreign_enum_functor_desc(_TypeCtorRep::in(foreign_enum), X::in,
TypeFunctors::in) = (ForeignEnumFunctorDesc::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- ForeignEnumFunctorDesc = (TypeFunctors.functors_foreign_enum())[X];
+ ForeignEnumFunctorDesc = null;
+ foreach (ForeignEnumFunctorDesc desc
+ in TypeFunctors.functors_foreign_enum())
+ {
+ if (desc.foreign_enum_functor_value == X) {
+ ForeignEnumFunctorDesc = desc;
+ break;
+ }
+ }
").
:- pragma foreign_proc("Java",
@@ -4773,7 +4903,13 @@ foreign_enum_functor_desc(_, Num, TypeFunctors) = ForeignEnumFunctorDesc :-
TypeFunctors::in) = (ForeignEnumFunctorDesc::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- ForeignEnumFunctorDesc = (TypeFunctors.functors_foreign_enum())[X];
+ ForeignEnumFunctorDesc = null;
+ for (ForeignEnumFunctorDesc desc : TypeFunctors.functors_foreign_enum()) {
+ if (desc.foreign_enum_functor_value == X) {
+ ForeignEnumFunctorDesc = desc;
+ break;
+ }
+ }
").
:- func foreign_enum_functor_name(foreign_enum_functor_desc) = string.
@@ -4795,6 +4931,24 @@ foreign_enum_functor_name(ForeignEnumFunctorDesc) =
Name = ForeignEnumFunctorDesc.foreign_enum_functor_name;
").
+:- func foreign_enum_functor_ordinal(foreign_enum_functor_desc) = int.
+
+foreign_enum_functor_ordinal(_) = -1.
+
+:- pragma foreign_proc("C#",
+ foreign_enum_functor_ordinal(ForeignEnumFunctorDesc::in) = (Ordinal::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Ordinal = ForeignEnumFunctorDesc.foreign_enum_functor_ordinal;
+").
+
+:- pragma foreign_proc("Java",
+ foreign_enum_functor_ordinal(ForeignEnumFunctorDesc::in) = (Ordinal::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Ordinal = ForeignEnumFunctorDesc.foreign_enum_functor_ordinal;
+").
+
%-----------------------------------------------------------------------------%
:- func notag_functor_desc(type_ctor_rep, int, type_functors)
@@ -4991,6 +5145,13 @@ unsafe_get_enum_value(_) = _ :-
:- func unsafe_get_foreign_enum_value(T) = int.
+:- pragma foreign_proc("C#",
+ unsafe_get_foreign_enum_value(T::in) = (Value::out),
+ [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+"
+ Value = (int) T;
+").
+
% XXX We cannot provide a Java version of this until mlds_to_java.m is
% updated to support foreign enumerations.
diff --git a/library/string.m b/library/string.m
index c8e6dc3..cd54acf 100644
--- a/library/string.m
+++ b/library/string.m
@@ -1250,6 +1250,18 @@ string.c_pointer_to_string(C_Pointer, Str) :-
private_builtin.unsafe_type_cast(C_Pointer, Int),
Str = "c_pointer(0x" ++ string.int_to_base_string(Int, 16) ++ ")".
+:- pragma foreign_proc("C#",
+ string.c_pointer_to_string(C_Pointer::in, Str::uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ /* Within the spirit of the function, at least. */
+ if (C_Pointer == null) {
+ Str = ""null"";
+ } else {
+ Str = C_Pointer.ToString();
+ }
+").
+
:- pragma foreign_proc("Java",
string.c_pointer_to_string(C_Pointer::in, Str::uo),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -1578,6 +1590,29 @@ string.from_rev_char_list(Chars, Str) :-
}
}").
+:- pragma foreign_proc("C#",
+ string.semidet_from_rev_char_list(Chars::in, Str::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+ does_not_affect_liveness, may_not_duplicate, no_sharing],
+"
+ int size = 0;
+ list.List_1 list_ptr = Chars;
+ while (!list.is_empty(list_ptr)) {
+ size++;
+ list_ptr = list.det_tail(list_ptr);
+ }
+
+ char[] arr = new char[size];
+ list_ptr = Chars;
+ while (!list.is_empty(list_ptr)) {
+ arr[--size] = (char) list.det_head(list_ptr);
+ list_ptr = list.det_tail(list_ptr);
+ }
+
+ Str = new string(arr);
+ SUCCESS_INDICATOR = true;
+").
+
string.semidet_from_rev_char_list(Chars::in, Str::uo) :-
string.semidet_from_char_list(list.reverse(Chars), Str).
diff --git a/library/thread.m b/library/thread.m
index 3a07c33..589d113 100644
--- a/library/thread.m
+++ b/library/thread.m
@@ -95,6 +95,13 @@
#endif
").
+:- pragma foreign_proc("C#",
+ can_spawn,
+ [will_not_call_mercury, promise_pure],
+"
+ SUCCESS_INDICATOR = true;
+").
+
:- pragma foreign_proc("Java",
can_spawn,
[will_not_call_mercury, promise_pure],
@@ -193,6 +200,16 @@
IO = IO0;
").
+:- pragma foreign_proc("C#",
+ yield(IO0::di, IO::uo),
+ [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io,
+ may_not_duplicate],
+"
+ // Only available in .NET 4.0.
+ // System.Threading.Yield();
+ IO = IO0;
+").
+
:- pragma foreign_proc("Java",
yield(IO0::di, IO::uo),
[promise_pure, will_not_call_mercury, thread_safe, tabled_for_io,
diff --git a/library/type_desc.m b/library/type_desc.m
index 73d2e9d..828aa76 100644
--- a/library/type_desc.m
+++ b/library/type_desc.m
@@ -1089,9 +1089,7 @@ get_type_info_for_type_info = TypeDesc :-
runtime.PseudoTypeInfo x,
runtime.PseudoTypeInfo y)
{
- runtime.Errors.SORRY(
- ""foreign code for comparing pseudo_type_desc"");
- return builtin.Comparison_result_0.f_equal;
+ return rtti_implementation.ML_compare_pseudo_type_infos(x, y);
}
").
@@ -1130,9 +1128,7 @@ get_type_info_for_type_info = TypeDesc :-
public static builtin.Comparison_result_0
__Compare____pseudo_type_desc_0_0(PseudoTypeInfo x, PseudoTypeInfo y)
{
- // stub only
- throw new java.lang.Error(
- ""__Compare____pseudo_type_desc_0_0 not implemented"");
+ return rtti_implementation.ML_compare_pseudo_type_infos(x, y);
}
").
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list