[m-rev.] diff: java versions of remaining bitmap predicates

[Peter Wang]

Branches: main

configure.in:
        Check that the bootstrap compiler accepts pragma foreign_export_enum
        for Java.

library/builtin.m:
        Export comparison_result functors so they can be returned easily from
        Java foreign code.

library/bitmap.m:
        Replace remaining predicates with native Java versions.

tests/hard_coded/bit_buffer_test.m:
        Fix formatting.

diff --git a/configure.in b/configure.in
index d05fcef..0b1e993 100644
--- a/configure.in
+++ b/configure.in
@@ -262,6 +262,9 @@ if test "$BOOTSTRAP_MC" != ""; then
 
         :- type t    ---> a ; b ; c(int).
 
+        :- type bear ---> brown ; black ; teddy.
+        :- pragma foreign_export_enum("Java", bear/0).
+
         :- pragma foreign_export("IL", p(out), "IL_EXPORT").
 
         :- pred p(t::out) is det.
diff --git a/library/bitmap.m b/library/bitmap.m
index a5bc775..fbf3278 100644
--- a/library/bitmap.m
+++ b/library/bitmap.m
@@ -1139,7 +1139,17 @@ copy_bytes(SameBM, SrcBM, SrcStartByte, DestBM, DestStartByte, NumBytes) =
         MR_memcpy(DestBM->elements + DestFirstByteIndex,
             SrcBM->elements + SrcFirstByteIndex, NumBytes);
     }
+").
 
+:- pragma foreign_proc("Java",
+    unsafe_copy_bytes(_SameBM::in, SrcBM::in, SrcFirstByteIndex::in,
+        DestBM0::bitmap_di, DestFirstByteIndex::in,
+        NumBytes::in) = (DestBM::bitmap_uo),
+    [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
+"
+    DestBM = DestBM0;
+    System.arraycopy(SrcBM.elements, SrcFirstByteIndex,
+        DestBM.elements, DestFirstByteIndex, NumBytes);
 ").
 
 unsafe_copy_bytes(SameBM, SrcBM, SrcFirstByteIndex,
@@ -1571,6 +1581,13 @@ public class MercuryBitmap {
     SUCCESS_INDICATOR = MR_bitmap_eq(BM1, BM2);
 ").
 
+:- pragma foreign_proc("Java",
+    bitmap_equal(BM1::in, BM2::in),
+    [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
+"
+    succeeded = java.util.Arrays.equals(BM1.elements, BM2.elements);
+").
+
 :- pragma foreign_proc("Erlang",
     bitmap_equal(BM1::in, BM2::in),
     [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
@@ -1608,6 +1625,32 @@ bytes_equal(Index, MaxIndex, BM1, BM2) :-
                 : MR_COMPARE_GREATER);
 ").
 
+:- pragma foreign_proc("Java",
+    bitmap_compare(Result::uo, BM1::in, BM2::in),
+    [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail,
+        may_not_duplicate],
+"
+    if (BM1.num_bits < BM2.num_bits) {
+        Result = builtin.ML_COMPARE_LESS;
+    } else if (BM1.num_bits > BM2.num_bits) {
+        Result = builtin.ML_COMPARE_GREATER;
+    } else {
+        Result = builtin.ML_COMPARE_EQUAL;
+        for (int i = 0; i < BM1.elements.length; i++) {
+            byte b1 = BM1.elements[i];
+            byte b2 = BM2.elements[i];
+            if (b1 < b2) {
+                Result = builtin.ML_COMPARE_LESS;
+                break;
+            }
+            if (b1 > b2) {
+                Result = builtin.ML_COMPARE_GREATER;
+                break;
+            }
+        }
+    }
+").
+
 :- pragma foreign_proc("Erlang",
     bitmap_compare(Result::uo, BM1::in, BM2::in),
     [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
@@ -1752,7 +1795,7 @@ _ ^ unsafe_byte(_) = _ :- private_builtin.sorry("bitmap.unsafe_byte").
     unsafe_byte(N::in, BM::in) = (Byte::out),
     [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
 "
-    // Mask off sign bits.
+    // Mask off sign bits so Byte is in range 0-255.
     Byte = ((int) BM.elements[N]) & 0xff;
 ").
 
@@ -1858,7 +1901,6 @@ resize_bitmap(OldBM, N) =
     copy_bits(OldBM, 0, allocate_bitmap(N), 0,
         int.min(OldBM ^ num_bits, N)).
 
-:- pragma promise_pure(copy/1).
 :- pragma foreign_proc("C",
     copy(BM0::in) = (BM::bitmap_uo),
     [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
@@ -1867,6 +1909,14 @@ resize_bitmap(OldBM, N) =
     MR_copy_bitmap(BM, BM0);
 ").
 
+:- pragma foreign_proc("Java",
+    copy(BM0::in) = (BM::bitmap_uo),
+    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
+"
+    BM = new bitmap.MercuryBitmap(BM0.num_bits);
+    System.arraycopy(BM0.elements, 0, BM.elements, 0, BM0.elements.length);
+").
+
 :- pragma foreign_proc("Erlang",
     copy(BM0::in) = (BM::bitmap_uo),
     [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
diff --git a/library/builtin.m b/library/builtin.m
index 75d7fd8..5894503 100644
--- a/library/builtin.m
+++ b/library/builtin.m
@@ -602,6 +602,13 @@ get_one_solution_io(Pred, X, !IO) :-
 :- external(compare/3).
 :- external(compare_representation/3).
 
+:- pragma foreign_export_enum("Java", comparison_result/0, [],
+    [
+        (=) - "ML_COMPARE_EQUAL",
+        (<) - "ML_COMPARE_LESS",
+        (>) - "ML_COMPARE_GREATER"
+    ]).
+
 ordering(X, Y) = R :-
     compare(R, X, Y).
 
diff --git a/tests/hard_coded/bit_buffer_test.m b/tests/hard_coded/bit_buffer_test.m
index 65fad11..498c054 100644
--- a/tests/hard_coded/bit_buffer_test.m
+++ b/tests/hard_coded/bit_buffer_test.m
@@ -253,7 +253,11 @@ test_error_sequence(ErrorTestType, BufferSize,
     io.nl(!IO),
     ExpectedBM = requests_to_bitmap(SetupRequests),
     TempFile = bit_buffer_test_tmp_file,
-    ( ( ErrorTestType = io_and_bitmap ; ErrorTestType = timebomb(_) ) ->
+    (
+        ( ErrorTestType = io_and_bitmap
+        ; ErrorTestType = timebomb(_)
+        )
+    ->
         test_writes(8, TempFile, SetupRequests, ExpectedBM, !IO)
     ;
         true
@@ -368,7 +372,7 @@ test_writes(BufferSize, FileName, Writes, ExpectedBM, !IO) :-
                 BMReadResult = ok(ReadBM),
                 ( ReadBM = ExpectedBM ->
                     io.write_string("I/O bitmap compares OK.\n", !IO),
-                io.flush_output(!IO)
+                    io.flush_output(!IO)
                 ;
                     io.write_string("I/O bitmap differs: \n", !IO),
                     io.write_string(to_byte_string(ReadBM), !IO),

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------