diff --git a/lib/srfi/160/base.sld b/lib/srfi/160/base.sld index f2f62cbd..bce22d49 100644 --- a/lib/srfi/160/base.sld +++ b/lib/srfi/160/base.sld @@ -121,24 +121,92 @@ (define (c128vector . ls) (list->c128vector ls)) (define (make-u1vector len) (make-uvector SEXP_U1 len)) (define make-u8vector make-bytevector) - (define (make-s8vector len) (make-uvector SEXP_S8 len)) - (define (make-u16vector len) (make-uvector SEXP_U16 len)) - (define (make-s16vector len) (make-uvector SEXP_S16 len)) - (define (make-u32vector len) (make-uvector SEXP_U32 len)) - (define (make-s32vector len) (make-uvector SEXP_S32 len)) - (define (make-u64vector len) (make-uvector SEXP_U64 len)) - (define (make-s64vector len) (make-uvector SEXP_S64 len)) - (define (make-f32vector len) (make-uvector SEXP_F32 len)) - (define (make-f64vector len) (make-uvector SEXP_F64 len)) - (define (make-c64vector len) (make-uvector SEXP_C64 len)) - (define (make-c128vector len) (make-uvector SEXP_C128 len)) + (define (make-s8vector len . o) + (let ((res (make-uvector SEXP_S8 len))) + (if (and (pair? o) (not (zero? (car o)))) + (do ((i 0 (+ i 1))) + ((>= i len)) + (s8vector-set! res i (car o)))) + res)) + (define (make-u16vector len . o) + (let ((res (make-uvector SEXP_U16 len))) + (if (and (pair? o) (not (zero? (car o)))) + (do ((i 0 (+ i 1))) + ((>= i len)) + (u16vector-set! res i (car o)))) + res)) + (define (make-s16vector len . o) + (let ((res (make-uvector SEXP_S16 len))) + (if (and (pair? o) (not (zero? (car o)))) + (do ((i 0 (+ i 1))) + ((>= i len)) + (s16vector-set! res i (car o)))) + res)) + (define (make-u32vector len . o) + (let ((res (make-uvector SEXP_U32 len))) + (if (and (pair? o) (not (zero? (car o)))) + (do ((i 0 (+ i 1))) + ((>= i len)) + (u32vector-set! res i (car o)))) + res)) + (define (make-s32vector len . o) + (let ((res (make-uvector SEXP_S32 len))) + (if (and (pair? o) (not (zero? (car o)))) + (do ((i 0 (+ i 1))) + ((>= i len)) + (s32vector-set! res i (car o)))) + res)) + (define (make-u64vector len . o) + (let ((res (make-uvector SEXP_U64 len))) + (if (and (pair? o) (not (zero? (car o)))) + (do ((i 0 (+ i 1))) + ((>= i len)) + (u64vector-set! res i (car o)))) + res)) + (define (make-s64vector len . o) + (let ((res (make-uvector SEXP_S64 len))) + (if (and (pair? o) (not (zero? (car o)))) + (do ((i 0 (+ i 1))) + ((>= i len)) + (s64vector-set! res i (car o)))) + res)) + (define (make-f32vector len . o) + (let ((res (make-uvector SEXP_F32 len))) + (if (and (pair? o) (not (zero? (car o)))) + (do ((i 0 (+ i 1))) + ((>= i len)) + (f32vector-set! res i (car o)))) + res)) + (define (make-f64vector len . o) + (let ((res (make-uvector SEXP_F64 len))) + (if (and (pair? o) (not (zero? (car o)))) + (do ((i 0 (+ i 1))) + ((>= i len)) + (f64vector-set! res i (car o)))) + res)) + (define (make-c64vector len . o) + (let ((res (make-uvector SEXP_C64 len))) + (if (and (pair? o) (not (zero? (car o)))) + (do ((i 0 (+ i 1))) + ((>= i len)) + (c64vector-set! res i (car o)))) + res)) + (define (make-c128vector len . o) + (let ((res (make-uvector SEXP_C128 len))) + (if (and (pair? o) (not (zero? (car o)))) + (do ((i 0 (+ i 1))) + ((>= i len)) + (c128vector-set! res i (car o)))) + res)) (define-syntax define-uvector->list (syntax-rules () ((define-uvector->list uv->list len ref) - (define (uv->list uv) - (do ((i (- (len uv) 1) (- i 1)) - (res '() (cons (ref uv i) res))) - ((< i 0) res)))))) + (define (uv->list uv . o) + (let ((start (if (pair? o) (car o) 0)) + (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (len uv)))) + (do ((i (- end 1) (- i 1)) + (res '() (cons (ref uv i) res))) + ((< i start) res))))))) (define-uvector->list u1vector->list u1vector-length u1vector-ref) (define-uvector->list u8vector->list bytevector-length bytevector-u8-ref) (define-uvector->list s8vector->list s8vector-length s8vector-ref) diff --git a/lib/srfi/160/c128.sld b/lib/srfi/160/c128.sld index 83e8eaeb..36971ddf 100644 --- a/lib/srfi/160/c128.sld +++ b/lib/srfi/160/c128.sld @@ -7,7 +7,6 @@ c128vector-ref c128vector-set! c128vector-length - (rename vector c128vector) (rename uvector-unfold c128vector-unfold) (rename uvector-unfold-right c128vector-unfold-right) (rename vector-copy c128vector-copy) @@ -48,9 +47,7 @@ (rename vector-reverse! c128vector-reverse!) (rename vector-copy! c128vector-copy!) (rename vector-reverse-copy! c128vector-reverse-copy!) - (rename uvector->list c128vector->list) (rename reverse-vector->list reverse-c128vector->list) - (rename list->uvector list->c128vector) (rename reverse-list->vector reverse-list->c128vector) (rename uvector->vector c128vector->vector) (rename vector->uvector vector->c128vector) @@ -64,6 +61,9 @@ (begin (define uvector? c128vector?) (define make-uvector make-c128vector) + (define vector c128vector) + (define uvector->list c128vector->list) + (define list->uvector list->c128vector) (define uvector-length c128vector-length) (define uvector-ref c128vector-ref) (define uvector-set! c128vector-set!)) diff --git a/lib/srfi/160/c64.sld b/lib/srfi/160/c64.sld index 99d4ae4f..4934d918 100644 --- a/lib/srfi/160/c64.sld +++ b/lib/srfi/160/c64.sld @@ -7,7 +7,6 @@ c64vector-ref c64vector-set! c64vector-length - (rename vector c64vector) (rename uvector-unfold c64vector-unfold) (rename uvector-unfold-right c64vector-unfold-right) (rename vector-copy c64vector-copy) @@ -48,9 +47,7 @@ (rename vector-reverse! c64vector-reverse!) (rename vector-copy! c64vector-copy!) (rename vector-reverse-copy! c64vector-reverse-copy!) - (rename uvector->list c64vector->list) (rename reverse-vector->list reverse-c64vector->list) - (rename list->uvector list->c64vector) (rename reverse-list->vector reverse-list->c64vector) (rename uvector->vector c64vector->vector) (rename vector->uvector vector->c64vector) @@ -64,6 +61,9 @@ (begin (define uvector? c64vector?) (define make-uvector make-c64vector) + (define vector c64vector) + (define uvector->list c64vector->list) + (define list->uvector list->c64vector) (define uvector-length c64vector-length) (define uvector-ref c64vector-ref) (define uvector-set! c64vector-set!)) diff --git a/lib/srfi/160/f32.sld b/lib/srfi/160/f32.sld index ec924278..47c48dad 100644 --- a/lib/srfi/160/f32.sld +++ b/lib/srfi/160/f32.sld @@ -7,7 +7,6 @@ f32vector-ref f32vector-set! f32vector-length - (rename vector f32vector) (rename uvector-unfold f32vector-unfold) (rename uvector-unfold-right f32vector-unfold-right) (rename vector-copy f32vector-copy) @@ -48,9 +47,7 @@ (rename vector-reverse! f32vector-reverse!) (rename vector-copy! f32vector-copy!) (rename vector-reverse-copy! f32vector-reverse-copy!) - (rename uvector->list f32vector->list) (rename reverse-vector->list reverse-f32vector->list) - (rename list->uvector list->f32vector) (rename reverse-list->vector reverse-list->f32vector) (rename uvector->vector f32vector->vector) (rename vector->uvector vector->f32vector) @@ -64,6 +61,9 @@ (begin (define uvector? f32vector?) (define make-uvector make-f32vector) + (define vector f32vector) + (define uvector->list f32vector->list) + (define list->uvector list->f32vector) (define uvector-length f32vector-length) (define uvector-ref f32vector-ref) (define uvector-set! f32vector-set!)) diff --git a/lib/srfi/160/f64.sld b/lib/srfi/160/f64.sld index 628fdf12..15e05bab 100644 --- a/lib/srfi/160/f64.sld +++ b/lib/srfi/160/f64.sld @@ -7,7 +7,6 @@ f64vector-ref f64vector-set! f64vector-length - (rename vector f64vector) (rename uvector-unfold f64vector-unfold) (rename uvector-unfold-right f64vector-unfold-right) (rename vector-copy f64vector-copy) @@ -48,9 +47,7 @@ (rename vector-reverse! f64vector-reverse!) (rename vector-copy! f64vector-copy!) (rename vector-reverse-copy! f64vector-reverse-copy!) - (rename uvector->list f64vector->list) (rename reverse-vector->list reverse-f64vector->list) - (rename list->uvector list->f64vector) (rename reverse-list->vector reverse-list->f64vector) (rename uvector->vector f64vector->vector) (rename vector->uvector vector->f64vector) @@ -64,6 +61,9 @@ (begin (define uvector? f64vector?) (define make-uvector make-f64vector) + (define vector f64vector) + (define uvector->list f64vector->list) + (define list->uvector list->f64vector) (define uvector-length f64vector-length) (define uvector-ref f64vector-ref) (define uvector-set! f64vector-set!)) diff --git a/lib/srfi/160/s16.sld b/lib/srfi/160/s16.sld index 8b98c41a..d8b4f1e6 100644 --- a/lib/srfi/160/s16.sld +++ b/lib/srfi/160/s16.sld @@ -7,7 +7,6 @@ s16vector-ref s16vector-set! s16vector-length - (rename vector s16vector) (rename uvector-unfold s16vector-unfold) (rename uvector-unfold-right s16vector-unfold-right) (rename vector-copy s16vector-copy) @@ -48,9 +47,7 @@ (rename vector-reverse! s16vector-reverse!) (rename vector-copy! s16vector-copy!) (rename vector-reverse-copy! s16vector-reverse-copy!) - (rename uvector->list s16vector->list) (rename reverse-vector->list reverse-s16vector->list) - (rename list->uvector list->s16vector) (rename reverse-list->vector reverse-list->s16vector) (rename uvector->vector s16vector->vector) (rename vector->uvector vector->s16vector) @@ -64,6 +61,9 @@ (begin (define uvector? s16vector?) (define make-uvector make-s16vector) + (define vector s16vector) + (define uvector->list s16vector->list) + (define list->uvector list->s16vector) (define uvector-length s16vector-length) (define uvector-ref s16vector-ref) (define uvector-set! s16vector-set!)) diff --git a/lib/srfi/160/s32.sld b/lib/srfi/160/s32.sld index 33bfb1cc..9914e937 100644 --- a/lib/srfi/160/s32.sld +++ b/lib/srfi/160/s32.sld @@ -7,7 +7,6 @@ s32vector-ref s32vector-set! s32vector-length - (rename vector s32vector) (rename uvector-unfold s32vector-unfold) (rename uvector-unfold-right s32vector-unfold-right) (rename vector-copy s32vector-copy) @@ -48,9 +47,7 @@ (rename vector-reverse! s32vector-reverse!) (rename vector-copy! s32vector-copy!) (rename vector-reverse-copy! s32vector-reverse-copy!) - (rename uvector->list s32vector->list) (rename reverse-vector->list reverse-s32vector->list) - (rename list->uvector list->s32vector) (rename reverse-list->vector reverse-list->s32vector) (rename uvector->vector s32vector->vector) (rename vector->uvector vector->s32vector) @@ -64,6 +61,9 @@ (begin (define uvector? s32vector?) (define make-uvector make-s32vector) + (define vector s32vector) + (define uvector->list s32vector->list) + (define list->uvector list->s32vector) (define uvector-length s32vector-length) (define uvector-ref s32vector-ref) (define uvector-set! s32vector-set!)) diff --git a/lib/srfi/160/s64.sld b/lib/srfi/160/s64.sld index de9aaafd..8c5bbbda 100644 --- a/lib/srfi/160/s64.sld +++ b/lib/srfi/160/s64.sld @@ -7,7 +7,6 @@ s64vector-ref s64vector-set! s64vector-length - (rename vector s64vector) (rename uvector-unfold s64vector-unfold) (rename uvector-unfold-right s64vector-unfold-right) (rename vector-copy s64vector-copy) @@ -48,9 +47,7 @@ (rename vector-reverse! s64vector-reverse!) (rename vector-copy! s64vector-copy!) (rename vector-reverse-copy! s64vector-reverse-copy!) - (rename uvector->list s64vector->list) (rename reverse-vector->list reverse-s64vector->list) - (rename list->uvector list->s64vector) (rename reverse-list->vector reverse-list->s64vector) (rename uvector->vector s64vector->vector) (rename vector->uvector vector->s64vector) @@ -64,6 +61,10 @@ (begin (define uvector? s64vector?) (define make-uvector make-s64vector) + (define vector s64vector) + (define uvector->list s64vector->list) + (define list->uvector list->s64vector) + (define uvector->list s64vector->list) (define uvector-length s64vector-length) (define uvector-ref s64vector-ref) (define uvector-set! s64vector-set!)) diff --git a/lib/srfi/160/s8.sld b/lib/srfi/160/s8.sld index a92219ed..94aa3987 100644 --- a/lib/srfi/160/s8.sld +++ b/lib/srfi/160/s8.sld @@ -7,7 +7,6 @@ s8vector-ref s8vector-set! s8vector-length - (rename vector s8vector) (rename uvector-unfold s8vector-unfold) (rename uvector-unfold-right s8vector-unfold-right) (rename vector-copy s8vector-copy) @@ -48,9 +47,7 @@ (rename vector-reverse! s8vector-reverse!) (rename vector-copy! s8vector-copy!) (rename vector-reverse-copy! s8vector-reverse-copy!) - (rename uvector->list s8vector->list) (rename reverse-vector->list reverse-s8vector->list) - (rename list->uvector list->s8vector) (rename reverse-list->vector reverse-list->s8vector) (rename uvector->vector s8vector->vector) (rename vector->uvector vector->s8vector) @@ -64,6 +61,9 @@ (begin (define uvector? s8vector?) (define make-uvector make-s8vector) + (define vector s8vector) + (define uvector->list s8vector->list) + (define list->uvector list->s8vector) (define uvector-length s8vector-length) (define uvector-ref s8vector-ref) (define uvector-set! s8vector-set!)) diff --git a/lib/srfi/160/test.sld b/lib/srfi/160/test.sld index c70e3091..c3eb3816 100644 --- a/lib/srfi/160/test.sld +++ b/lib/srfi/160/test.sld @@ -1,6 +1,6 @@ (define-library (srfi 160 test) (import (scheme base) - (srfi 160 u32) (srfi 160 u64) (srfi 160 s64) + (srfi 160 base) (srfi 160 u32) (srfi 160 u64) (srfi 160 s64) (chibi test)) (export run-tests) (begin @@ -154,4 +154,40 @@ (test '#u32(3 2 1) (reverse-list->u32vector '(1 2 3))) ) + (test-group "bitvectors" + (let ((uv #u1(0 1 0 1 0 1 0))) + (test 0 (u1vector-ref uv 0)) + (test 1 (u1vector-ref uv 1)) + (test 0 (u1vector-ref uv 2)) + (test 1 (u1vector-ref uv 3)) + (test 0 (u1vector-ref uv 4)) + (test 1 (u1vector-ref uv 5)) + (test 0 (u1vector-ref uv 6)) + (test-error (u1vector-ref uv -1)) + (test-error (u1vector-ref uv 7))) + (let ((uv #u1(1 0 1 0 1 0 1 0))) + (test 1 (u1vector-ref uv 0)) + (test 0 (u1vector-ref uv 1)) + (test 1 (u1vector-ref uv 2)) + (test 0 (u1vector-ref uv 3)) + (test 1 (u1vector-ref uv 4)) + (test 0 (u1vector-ref uv 5)) + (test 1 (u1vector-ref uv 6)) + (test 0 (u1vector-ref uv 7)) + (test-error (u1vector-ref uv -1)) + (test-error (u1vector-ref uv 8))) + (let ((uv #u1(0 1 0 1 0 1 0 1 0))) + (test 0 (u1vector-ref uv 0)) + (test 1 (u1vector-ref uv 1)) + (test 0 (u1vector-ref uv 2)) + (test 1 (u1vector-ref uv 3)) + (test 0 (u1vector-ref uv 4)) + (test 1 (u1vector-ref uv 5)) + (test 0 (u1vector-ref uv 6)) + (test 1 (u1vector-ref uv 7)) + (test 0 (u1vector-ref uv 8)) + (test-error (u1vector-ref uv -1)) + (test-error (u1vector-ref uv 9))) + ) + (test-end)))) diff --git a/lib/srfi/160/u16.sld b/lib/srfi/160/u16.sld index 133b4801..88325d28 100644 --- a/lib/srfi/160/u16.sld +++ b/lib/srfi/160/u16.sld @@ -7,7 +7,6 @@ u16vector-ref u16vector-set! u16vector-length - (rename vector u16vector) (rename uvector-unfold u16vector-unfold) (rename uvector-unfold-right u16vector-unfold-right) (rename vector-copy u16vector-copy) @@ -48,9 +47,7 @@ (rename vector-reverse! u16vector-reverse!) (rename vector-copy! u16vector-copy!) (rename vector-reverse-copy! u16vector-reverse-copy!) - (rename uvector->list u16vector->list) (rename reverse-vector->list reverse-u16vector->list) - (rename list->uvector list->u16vector) (rename reverse-list->vector reverse-list->u16vector) (rename uvector->vector u16vector->vector) (rename vector->uvector vector->u16vector) @@ -64,6 +61,9 @@ (begin (define uvector? u16vector?) (define make-uvector make-u16vector) + (define vector u16vector) + (define uvector->list u16vector->list) + (define list->uvector list->u16vector) (define uvector-length u16vector-length) (define uvector-ref u16vector-ref) (define uvector-set! u16vector-set!)) diff --git a/lib/srfi/160/u32.sld b/lib/srfi/160/u32.sld index 968787f3..56a5f60c 100644 --- a/lib/srfi/160/u32.sld +++ b/lib/srfi/160/u32.sld @@ -7,7 +7,6 @@ u32vector-ref u32vector-set! u32vector-length - (rename vector u32vector) (rename uvector-unfold u32vector-unfold) (rename uvector-unfold-right u32vector-unfold-right) (rename vector-copy u32vector-copy) @@ -48,9 +47,7 @@ (rename vector-reverse! u32vector-reverse!) (rename vector-copy! u32vector-copy!) (rename vector-reverse-copy! u32vector-reverse-copy!) - (rename uvector->list u32vector->list) (rename reverse-vector->list reverse-u32vector->list) - (rename list->uvector list->u32vector) (rename reverse-list->vector reverse-list->u32vector) (rename uvector->vector u32vector->vector) (rename vector->uvector vector->u32vector) @@ -64,6 +61,9 @@ (begin (define uvector? u32vector?) (define make-uvector make-u32vector) + (define vector u32vector) + (define uvector->list u32vector->list) + (define list->uvector list->u32vector) (define uvector-length u32vector-length) (define uvector-ref u32vector-ref) (define uvector-set! u32vector-set!)) diff --git a/lib/srfi/160/u64.sld b/lib/srfi/160/u64.sld index 7c04249b..075be3b3 100644 --- a/lib/srfi/160/u64.sld +++ b/lib/srfi/160/u64.sld @@ -7,7 +7,6 @@ u64vector-ref u64vector-set! u64vector-length - (rename vector u64vector) (rename uvector-unfold u64vector-unfold) (rename uvector-unfold-right u64vector-unfold-right) (rename vector-copy u64vector-copy) @@ -48,9 +47,7 @@ (rename vector-reverse! u64vector-reverse!) (rename vector-copy! u64vector-copy!) (rename vector-reverse-copy! u64vector-reverse-copy!) - (rename uvector->list u64vector->list) (rename reverse-vector->list reverse-u64vector->list) - (rename list->uvector list->u64vector) (rename reverse-list->vector reverse-list->u64vector) (rename uvector->vector u64vector->vector) (rename vector->uvector vector->u64vector) @@ -64,6 +61,10 @@ (begin (define uvector? u64vector?) (define make-uvector make-u64vector) + (define vector u64vector) + (define uvector->list u64vector->list) + (define list->uvector list->u64vector) + (define uvector->list u64vector->list) (define uvector-length u64vector-length) (define uvector-ref u64vector-ref) (define uvector-set! u64vector-set!)) diff --git a/lib/srfi/160/u8.sld b/lib/srfi/160/u8.sld index 558a917e..3716e29e 100644 --- a/lib/srfi/160/u8.sld +++ b/lib/srfi/160/u8.sld @@ -7,7 +7,6 @@ u8vector-ref u8vector-set! u8vector-length - (rename vector u8vector) (rename uvector-unfold u8vector-unfold) (rename uvector-unfold-right u8vector-unfold-right) (rename vector-copy u8vector-copy) @@ -48,9 +47,7 @@ (rename vector-reverse! u8vector-reverse!) (rename vector-copy! u8vector-copy!) (rename vector-reverse-copy! u8vector-reverse-copy!) - (rename uvector->list u8vector->list) (rename reverse-vector->list reverse-u8vector->list) - (rename list->uvector list->u8vector) (rename reverse-list->vector reverse-list->u8vector) (rename uvector->vector u8vector->vector) (rename vector->uvector vector->u8vector) @@ -64,6 +61,9 @@ (begin (define uvector? u8vector?) (define make-uvector make-u8vector) + (define vector u8vector) + (define uvector->list u8vector->list) + (define list->uvector list->u8vector) (define uvector-length u8vector-length) (define uvector-ref u8vector-ref) (define uvector-set! u8vector-set!)) diff --git a/lib/srfi/160/uvector.scm b/lib/srfi/160/uvector.scm index 80adfcea..36f74512 100644 --- a/lib/srfi/160/uvector.scm +++ b/lib/srfi/160/uvector.scm @@ -17,19 +17,9 @@ (lp2 (+ i 1))))) (lp1 (cdr ls))))))) -(define (list->uvector ls) - (let ((res (make-uvector (length ls)))) - (do ((ls ls (cdr ls)) - (i 0 (+ i 1))) - ((null? ls) res) - (uvector-set! res i (car ls))))) - (define (reverse-list->uvector ls) (list->uvector (reverse ls))) -(define (vector . ls) - (list->uvector ls)) - (define (uvector-unfold f len seed) (let ((res (make-uvector len))) (let lp ((i 0) (seed seed)) @@ -315,9 +305,6 @@ (define (reverse-list->vector ls) (list->uvector (reverse ls))) -(define (uvector->list vec . o) - (reverse (apply reverse-vector->list vec o))) - (define (uvector->vector vec . o) (list->vector (apply uvector->list vec o)))