From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 7 Jan 2017 03:57:00 +0000 (-0800)
Subject: Implement bytevector=? and add bytevector support to equal?.
X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~191
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=657ece4d8bac9cd77bf85d45505346379218afce;p=mit-scheme.git

Implement bytevector=? and add bytevector support to equal?.
---

diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm
index b39b258a8..f01d322a5 100644
--- a/src/runtime/bytevector.scm
+++ b/src/runtime/bytevector.scm
@@ -85,6 +85,15 @@ USA.
    from
    (if (default-object? start) 0 start)
    (if (default-object? end) (bytevector-length from) end)))
+
+(define (bytevector=? b1 b2)
+  (let ((length (bytevector-length b1)))
+    (and (fix:= length (bytevector-length b2))
+	 (let loop ((index 0))
+	   (or (not (fix:< index length))
+	       (and (fix:= (bytevector-u8-ref b1 index)
+			   (bytevector-u8-ref b2 index))
+		    (loop (fix:+ index 1))))))))
 
 (define (string->utf8 string #!optional start end)
   (guarantee string? string 'string->utf8)
diff --git a/src/runtime/equals.scm b/src/runtime/equals.scm
index d2eae6721..8c5147b28 100644
--- a/src/runtime/equals.scm
+++ b/src/runtime/equals.scm
@@ -59,6 +59,8 @@ USA.
 			      (and (equal? (vector-ref x index)
 					   (vector-ref y index))
 				   (loop (fix:+ index 1))))))))
+		((bytevector? y)
+		 (bytevector=? x y))
 		((string? y)
 		 (string=? x y))
 		((number? y)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index e5b75c3af..c106c2a86 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1128,6 +1128,7 @@ USA.
 	  bytevector-length
 	  bytevector-u8-ref
 	  bytevector-u8-set!
+	  bytevector=?
 	  bytevector?
 	  make-bytevector
 	  string->utf8