Remove error checks from compact array implementations

Saves performance, doesn’t really affect safety since those are purely
internal procedures

Author: dpk

srfi/250/internal/r6rs-compact-arrays.scm

@@ -1,79 +1,68 @@
 (define (make-compact-array size)
-  (cond ((< size #xFF)
-         (let ((bv (make-bytevector (+ size 2) #xFF)))
+  (cond ((fx<? size #xFF)
+         (let ((bv (make-bytevector (fx+ size 2) #xFF)))
            (bytevector-u8-set! bv 0 1)
            (bytevector-u8-set! bv 1 size)
            bv))
-        ((< size #xFFFF)
-         (let ((bv (make-bytevector (* 2 (+ size 2)) #xFF)))
+        ((fx<? size #xFFFF)
+         (let ((bv (make-bytevector (fxarithmetic-shift-left (fx+ size 2) 1) #xFF)))
            (bytevector-u8-set! bv 0 2)
            (bytevector-u16-native-set! bv 2 size)
            bv))
-        ((< size #xFFFFFFFF)
-         (let ((bv (make-bytevector (* 4 (+ size 2)) #xFF)))
+        ((fx<? size #xFFFFFFFF)
+         (let ((bv (make-bytevector (fxarithmetic-shift-left (fx+ size 2) 2) #xFF)))
            (bytevector-u8-set! bv 0 4)
            (bytevector-u32-native-set! bv 4 size)
            bv))
         (else
-         (let ((bv (make-bytevector (* 8 (+ size 2)) #xFF)))
+         (let ((bv (make-bytevector (fxarithmetic-shift-left (fx+ size 2) 3) #xFF)))
            (bytevector-u8-set! bv 0 8)
            (bytevector-u64-native-set! bv 8 size)
            bv))))
 
 (define (compact-array-ref sa idx)
   (define (max-to x n) (if (eqv? x n) #f x))
-  (assert (bytevector? sa))
   (case (bytevector-u8-ref sa 0)
-    ((1) (max-to (bytevector-u8-ref sa (+ idx 2)) #xFF))
-    ((2) (max-to (bytevector-u16-native-ref sa (* (+ idx 2) 2)) #xFFFF))
-    ((4) (max-to (bytevector-u32-native-ref sa (* (+ idx 2) 4)) #xFFFFFFFF))
-    ((8) (max-to (bytevector-u64-native-ref sa (* (+ idx 2) 8)) #xFFFFFFFFFFFFFFFF))
-    (else (assertion-violation 'compact-array-ref "not a compact array" sa))))
+    ((1) (max-to (bytevector-u8-ref sa (fx+ idx 2)) #xFF))
+    ((2) (max-to (bytevector-u16-native-ref sa (fxarithmetic-shift-left (fx+ idx 2) 1)) #xFFFF))
+    ((4) (max-to (bytevector-u32-native-ref sa (fxarithmetic-shift-left (fx+ idx 2) 2)) #xFFFFFFFF))
+    ((8) (max-to (bytevector-u64-native-ref sa (fxarithmetic-shift-left (fx+ idx 2) 3)) #xFFFFFFFFFFFFFFFF))))
 
 (define (compact-array-set? sa idx)
   (not (not (compact-array-ref sa idx))))
 
 (define (compact-array-set! sa idx val)
-  (define (check-size n)
-    (if (>= val n) (assertion-violation 'compact-array-set! "can't store value in compact array, try upgrading it")))
-  (assert (bytevector? sa))
   (case (bytevector-u8-ref sa 0)
-    ((1) (check-size #xFF) (bytevector-u8-set! sa (+ idx 2) val))
-    ((2) (check-size #xFFFF) (bytevector-u16-native-set! sa (* (+ idx 2) 2) val))
-    ((4) (check-size #xFFFFFFFF) (bytevector-u32-native-set! sa (* (+ idx 2) 4) val))
-    ((8) (check-size #xFFFFFFFFFFFFFFFF) (bytevector-u64-native-set! sa (* (+ idx 2) 8) val))
-    (else (assertion-violation 'compact-array-set! "not a compact array" sa))))
+    ((1) (bytevector-u8-set! sa (fx+ idx 2) val))
+    ((2) (bytevector-u16-native-set! sa (fxarithmetic-shift-left (fx+ idx 2) 1) val))
+    ((4) (bytevector-u32-native-set! sa (fxarithmetic-shift-left (fx+ idx 2) 2) val))
+    ((8) (fxarithmetic-shift-left (fx+ idx 2) 3))))
 
 (define (compact-array-delete! sa idx)
-  (assert (bytevector? sa))
   (case (bytevector-u8-ref sa 0)
-    ((1) (bytevector-u8-set! sa (+ idx 2) #xFF))
-    ((2) (bytevector-u16-native-set! sa (* (+ idx 2) 2) #xFFFF))
-    ((4) (bytevector-u32-native-set! sa (* (+ idx 2) 4) #xFFFFFFFF))
-    ((8) (bytevector-u64-native-set! sa (* (+ idx 2) 8) #xFFFFFFFFFFFFFFFF))
-    (else (assertion-violation 'compact-array-delete! "not a compact array" sa))))
+    ((1) (bytevector-u8-set! sa (fx+ idx 2) #xFF))
+    ((2) (bytevector-u16-native-set! sa (fxarithmetic-shift-left (fx+ idx 2) 1) #xFFFF))
+    ((4) (bytevector-u32-native-set! sa (fxarithmetic-shift-left (fx+ idx 2) 2) #xFFFFFFFF))
+    ((8) (bytevector-u64-native-set! sa (fxarithmetic-shift-left (fx+ idx 2) 3) #xFFFFFFFFFFFFFFFF))))
 
 (define (compact-array-clear! sa)
-  (assert (bytevector? sa))
   (let ((elt-size (bytevector-u8-ref sa 0)))
     (bytevector-fill! sa #xFF)
     (bytevector-u8-set! sa 0 elt-size)
     (case elt-size
-      ((1) (bytevector-u8-set! sa 1 (- 2 (bytevector-length sa))))
+      ((1) (bytevector-u8-set! sa 1 (fx- (bytevector-length sa) 2)))
       ((2) (bytevector-u16-native-set! sa 2
-                                       (- 2 (div (bytevector-length sa) 2))))
+                                       (fx- (fxarithmetic-shift-right (bytevector-length sa) 1) 2)))
       ((4) (bytevector-u32-native-set! sa 4
-                                       (- 2 (div (bytevector-length sa) 4))))
+                                       (fx- (fxarithmetic-shift-right (bytevector-length sa) 2) 2)))
       ((8) (bytevector-u32-native-set! sa 8
-                                       (- 2 (div (bytevector-length sa) 8)))))))
+                                       (fx- (fxarithmetic-shift-right (bytevector-length sa) 3) 2))))))
 
 (define (compact-array-copy sa) (bytevector-copy sa))
 
 (define (compact-array-length sa)
-  (assert (bytevector? sa))
   (case (bytevector-u8-ref sa 0)
     ((1) (bytevector-u8-ref sa 1))
     ((2) (bytevector-u16-native-ref sa 2))
     ((4) (bytevector-u32-native-ref sa 4))
-    ((8) (bytevector-u64-native-ref sa 8))
-    (else (assertion-violation 'compact-array-ref "not a compact array" sa))))
+    ((8) (bytevector-u64-native-ref sa 8))))

srfi/250/internal/srfi-compact-arrays.scm

@@ -5,38 +5,24 @@
         (else (make-u64vector size #xFFFFFFFFFFFFFFFF))))
 
 (define (compact-array-ref sa idx)
-  (define (max-to n) (lambda (x) (if (= x n) #f x)))
+  (define (max-to n) (lambda (x) (if (eqv? x n) #f x)))
   (cond ((and (bytevector? sa) (bytevector-u8-ref sa idx))
          => (max-to #xFF))
         ((and (u16vector? sa) (u16vector-ref sa idx))
          => (max-to #xFFFF))
         ((and (u32vector? sa) (u32vector-ref sa idx))
          => (max-to #xFFFFFFFF))
         ((and (u64vector? sa) (u64vector-ref sa idx))
-         => (max-to #xFFFFFFFFFFFFFFFF))
-        (else (assertion-violation 'compact-array-ref
-                                   "not a compact array"
-                                   sa))))
+         => (max-to #xFFFFFFFFFFFFFFFF))))
 
 (define (compact-array-set? sa idx)
   (not (not (compact-array-ref sa idx))))
 
 (define (compact-array-set! sa idx val)
-  (define (set-with-max setter max)
-    (if (>= val max)
-        (assertion-violation 'compact-array-set!
-                             "can't store value in compact array, try upgrading it"
-                             val)
-        (setter sa idx val)))
-  (cond ((bytevector? sa)
-         (set-with-max bytevector-u8-set! #xFF))
-        ((u16vector? sa)
-         (set-with-max u16vector-set! #xFFFF))
-        ((u32vector? sa)
-         (set-with-max u32vector-set! #xFFFFFFFF))
-        ((u64vector? sa)
-         (set-with-max u64vector-set! #xFFFFFFFFFFFFFFFF))
-        (else (error "not a compact array" sa))))
+  (cond ((bytevector? sa) (bytevector-u8-set! sa idx val))
+        ((u16vector? sa)  (u16vector-set! sa idx val))
+        ((u32vector? sa)  (u32vector-set! sa idx val))
+        ((u64vector? sa)  (set-with-max u64vector-set! #xFFFFFFFFFFFFFFFF))))
 
 (define (compact-array-delete! sa idx)
   (cond ((bytevector? sa)
@@ -46,10 +32,7 @@
         ((u32vector? sa)
          (u32vector-set! sa idx #xFFFFFFFF))
         ((u64vector? sa)
-         (u64vector-set! sa idx #xFFFFFFFFFFFFFFFF))
-        (else (assertion-violation 'compact-array-delete!
-                                   "not a compact array"
-                                   sa))))
+         (u64vector-set! sa idx #xFFFFFFFFFFFFFFFF))))
 
 (define (compact-array-clear! sa)
   (define len (compact-array-length sa))
@@ -72,10 +55,7 @@
          (let loop ((idx 0))
            (when (< idx len)
              (u64vector-set! sa idx #xFFFFFFFFFFFFFFFF)
-             (loop (+ idx 1)))))
-        (else (assertion-violation 'compact-array-length
-                                   "not a compact array"
-                                   sa))))
+             (loop (+ idx 1)))))))
 
 (define (compact-array-copy sa)
   (define len (compact-array-length sa))
@@ -94,10 +74,7 @@
          (let ((out (make-u64vector len)))
            (let loop ((idx 0))
              (when (< idx len)
-               (u64vector-set! out idx (u64vector-ref sa idx))))))
-        (else (assertion-violation 'compact-array-copy
-                                   "not a compact array"
-                                   sa))))
+               (u64vector-set! out idx (u64vector-ref sa idx))))))))
 
 (define (compact-array-length sa)
   (cond ((bytevector? sa)
@@ -107,7 +84,4 @@
         ((u32vector? sa)
          (u32vector-length sa))
         ((u64vector? sa)
-         (u64vector-length sa))
-        (else (assertion-violation 'compact-array-length
-                                   "not a compact array"
-                                   sa))))
+         (u64vector-length sa))))