lib/rnrs/bytevectors.scm: minimal rnrs bytevectors.

lib/rnrs/bytevectors.scm

@@ -0,0 +1,22 @@
+;; rnrs compatibility
+(define (bytevector-u32-native-set! bv index value)
+  (when (not (= 0 index)) (error "bytevector-u32-native-set! index not zero: " index " value: " value))
+  (let ((x (list
+            (modulo value #x100)
+            (quotient (modulo value #x10000) #x100)
+            (quotient (modulo value #x1000000) #x10000)
+            (quotient value #x1000000))))
+    (set-car! bv (car x))
+    (set-cdr! bv (cdr x))
+    x))
+
+(define (bytevector-u16-native-set! bv index value)
+  (when (not (= 0 index)) (error "bytevector-u16-native-set! index not zero: " index " value: " value))
+  (let ((x (list (modulo value #x100)
+                 (quotient (modulo value #x10000) #x100))))
+    (set-car! bv (car x))
+    (set-cdr! bv (cdr x))
+    x))
+
+(define (make-bytevector length)
+  (make-list length 0))

scm.mes

@@ -52,12 +52,15 @@
 
 (define integer? number?)
 
+(define (make-list n . x)
+  (let ((fill (if (pair? x) (car x) *unspecified*)))
+    (let loop ((n n))
+      (if (= 0 n) '()
+          (cons fill (loop (- n 1)))))))
+
 (define (vector . rest) (list->vector rest))
 (define (make-vector n . x)
-  (let ((fill (if (pair? x) (car x) *unspecified*)))
-    (list->vector (let loop ((n n))
-                    (if (= 0 n) '()
-                        (cons fill (loop (- n 1))))))))
+  (list->vector (apply make-list (cons n x))))
 
 (define (assq-set! alist key val)
   (let ((entry (assq key alist)))

test/scm.test

@@ -74,6 +74,7 @@
 (pass-if "vector?" (vector? #(1 2 c)))
 (pass-if "vector-length" (seq? (vector-length #(1)) 1))
 (pass-if "list->vector" (sequal? (list->vector '(a b c)) #(a b c)))
+(pass-if "make-list" (sequal? (make-list 3 1) '(1 1 1)))
 (pass-if "vector" (sequal? #(vector 0 1 2) #(vector 0 1 2)))
 (when (not guile?)
   (pass-if "make-vector" (sequal? (make-vector 3) #(*unspecified* *unspecified* *unspecified*))))