artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

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

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-08-13 17:05:29 +02:00
parent 1d08cc7f6f
commit 1ddb703265
3 changed files with 30 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
lib/rnrs/bytevectors.scm Normal file
View file

@ -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))

11
scm.mes
View file

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

1
test/scm.test
View file

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