Implement bytevector<?.

diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm
index 094c9e5d282419f1dd88f67ebcd55fa09b4cb292..c77fecfb88841f97ae5237062e98bdc7b0bc9c99 100644 (file)
--- a/src/runtime/bytevector.scm
+++ b/src/runtime/bytevector.scm
@@ -106,6 +106,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 e4915192dbb8897045aeaf00ae6128aeff1b75fb..8aee738937f0a07c738308902831a9625c203be9 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1213,6 +1213,7 @@ USA.
          bytevector-u8-ref
          bytevector-u8-set!
          bytevector-zero-explicit!
+         bytevector<?
          bytevector=?
          bytevector?
          exact-nonnegative-integer->bytevector

diff --git a/tests/runtime/test-bytevector.scm b/tests/runtime/test-bytevector.scm
index b26c1bcfe6413fc7e385ab46313a5beb2d06d5e7..eca6472497395759056b88097fd5307f41e67a26 100644 (file)
--- a/tests/runtime/test-bytevector.scm
+++ b/tests/runtime/test-bytevector.scm
@@ -462,6 +462,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)
@@ -481,4 +500,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