lib/rnrs/bytevectors.scm: minimal rnrs bytevectors.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 13 Aug 2016 15:05:29 +0000 (17:05 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 13 Aug 2016 15:05:29 +0000 (17:05 +0200)
lib/rnrs/bytevectors.scm [new file with mode: 0644]
scm.mes
test/scm.test

diff --git a/lib/rnrs/bytevectors.scm b/lib/rnrs/bytevectors.scm
new file mode 100644 (file)
index 0000000..dce1ed8
--- /dev/null
@@ -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))
diff --git a/scm.mes b/scm.mes
index fe22b8ee958da203241703fdd6d38a65394f6c05..5c17a406f53049a934213011aaa01f664771d34a 100755 (executable)
--- a/scm.mes
+++ b/scm.mes
 
 (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)))
index 520f79820cfe9ba21acc14d9902740ea44ad005f..f2511546a0eef92d9928d79da83e0087a0fd9260 100644 (file)
@@ -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*))))