Implement bytevector<?.

diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm
index 00e1e772992a852570334fbc35fe1df4b07a8925..13902a458fb7bbcd30f0dd0e1a5aa573e9b37b58 100644 (file)
--- a/src/runtime/bytevector.scm
+++ b/src/runtime/bytevector.scm
@@ -102,6 +102,19 @@ USA.
                           (bytevector-u8-ref b2 index))
                    (loop (fix:+ index 1))))))))
 
+(define (bytevector<? b1 b2)
+  (let ((l1 (bytevector-length b1))
+       (l2 (bytevector-length b2)))
+    (let ((end (fix:min l1 l2)))
+      (let loop ((index 0))
+       (if (fix:< index end)
+           (let ((u1 (bytevector-u8-ref b1 index))
+                 (u2 (bytevector-u8-ref b2 index)))
+             (if (fix:= u1 u2)
+                 (loop (fix:+ index 1))
+                 (fix:< u1 u2)))
+           (fix:< l1 l2))))))
+
 ;; String hash primitives work on bytevectors too.
 (define (bytevector-hash bytevector #!optional modulus)
   (if (default-object? modulus)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index e2e7d51b2f0abe79d5926596995639a347ba2f67..bf839e9c8898eedb8bea55d63cdb044ced0999cd 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1183,6 +1183,7 @@ USA.
          bytevector-u32le-set!
          bytevector-u8-ref
          bytevector-u8-set!
+         bytevector<?
          bytevector=?
          bytevector?
          exact-nonnegative-integer->bytevector

diff --git a/tests/runtime/test-bytevector.scm b/tests/runtime/test-bytevector.scm
index b1f6b70023767306a1a165702581981e8cc21a03..1b380ddd85a4315ee0e135bece4317f7b30b90d3 100644 (file)
--- a/tests/runtime/test-bytevector.scm
+++ b/tests/runtime/test-bytevector.scm
@@ -432,6 +432,25 @@ USA.
                                         (bytevector-copy bv 11 22)
                                         bv1))))))
 
+(define-test 'bytevector<?
+  (lambda ()
+    (let ((lists (random-byte-lists 16 64)))
+      (for-each (lambda (l1)
+                 (for-each (lambda (l2)
+                             (assert-eqv (bytevector<? (bytes->bv l1)
+                                                       (bytes->bv l2))
+                                         (byte-list<? l1 l2)))
+                           lists))
+               lists))))
+
+(define (byte-list<? l1 l2)
+  (if (and (pair? l1) (pair? l2))
+      (if (fix:= (car l1) (car l2))
+         (byte-list<? (cdr l1) (cdr l2))
+         (fix:< (car l1) (car l2)))
+      (and (null? l1)
+          (not (null? l2)))))
+
 (define (build-bytevector objects)
   (let ((builder (bytevector-builder)))
     (for-each builder objects)
@@ -451,4 +470,16 @@ USA.
       (let ((start* (fix:+ start n)))
        (if (fix:<= start* end)
            (loop start* (cons (bytevector-copy bv start start*) bvs))
-           (reverse! bvs))))))
\ No newline at end of file
+           (reverse! bvs))))))
+
+(define (random-byte-lists n max-length)
+  (map (lambda (i)
+        (declare (ignore i))
+        (random-byte-list max-length))
+       (iota n)))
+
+(define (random-byte-list max-length)
+  (map (lambda (i)
+        (declare (ignore i))
+        (random #x100))
+       (iota (random (+ max-length 1)))))
\ No newline at end of file