Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

fleshing out srfi 160 api

Browse source
This commit is contained in:
Alex Shinn 2019-02-26 23:08:52 +08:00
parent a94a2c7902
commit a126417ebe
16 changed files with 1364 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

70
lib/srfi/160/c128.sld Normal file
View file

@ -0,0 +1,70 @@
(define-library (srfi 160 c128)
(export
make-c128vector
c128?
c128vector?
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)
(rename vector-reverse-copy c128vector-reverse-copy)
(rename vector-append c128vector-append)
(rename vector-concatenate c128vector-concatenate)
(rename vector-append-subvectors c128vector-append-subvectors)
(rename vector-empty? c128vector-empty?)
(rename vector= c128vector=)
(rename vector-take c128vector-take)
(rename vector-take-right c128vector-take-right)
(rename vector-drop c128vector-drop)
(rename vector-drop-right c128vector-drop-right)
(rename vector-segment c128vector-segment)
(rename vector-fold c128vector-fold)
(rename vector-fold-right c128vector-fold-right)
(rename vector-map c128vector-map)
(rename vector-map! c128vector-map!)
(rename vector-for-each c128vector-for-each)
(rename vector-count c128vector-count)
(rename vector-cumulate c128vector-cumulate)
(rename vector-take-while c128vector-take-while)
(rename vector-take-while-right c128vector-take-while-right)
(rename vector-drop-while c128vector-drop-while)
(rename vector-drop-while-right c128vector-drop-while-right)
(rename vector-index c128vector-index)
(rename vector-index-right c128vector-index-right)
(rename vector-skip c128vector-skip)
(rename vector-skip-right c128vector-skip-right)
(rename vector-binary-search c128vector-binary-search)
(rename vector-any c128vector-any)
(rename vector-every c128vector-every)
(rename vector-partition c128vector-partition)
(rename vector-filter c128vector-filter)
(rename vector-remove c128vector-remove)
(rename vector-swap! c128vector-swap!)
(rename vector-fill! c128vector-fill!)
(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)
(rename make-vector-generator make-c128vector-generator)
(rename write-vector write-c128vector))
(import (except (scheme base)
vector-append vector-copy vector-copy!
vector-map vector-for-each)
(scheme write)
(srfi 160 base))
(begin
(define uvector? c128vector?)
(define make-uvector make-c128vector)
(define uvector-length c128vector-length)
(define uvector-ref c128vector-ref)
(define uvector-set! c128vector-set!))
(include "uvector.scm"))

70
lib/srfi/160/c64.sld Normal file
View file

@ -0,0 +1,70 @@
(define-library (srfi 160 c64)
(export
make-c64vector
c64?
c64vector?
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)
(rename vector-reverse-copy c64vector-reverse-copy)
(rename vector-append c64vector-append)
(rename vector-concatenate c64vector-concatenate)
(rename vector-append-subvectors c64vector-append-subvectors)
(rename vector-empty? c64vector-empty?)
(rename vector= c64vector=)
(rename vector-take c64vector-take)
(rename vector-take-right c64vector-take-right)
(rename vector-drop c64vector-drop)
(rename vector-drop-right c64vector-drop-right)
(rename vector-segment c64vector-segment)
(rename vector-fold c64vector-fold)
(rename vector-fold-right c64vector-fold-right)
(rename vector-map c64vector-map)
(rename vector-map! c64vector-map!)
(rename vector-for-each c64vector-for-each)
(rename vector-count c64vector-count)
(rename vector-cumulate c64vector-cumulate)
(rename vector-take-while c64vector-take-while)
(rename vector-take-while-right c64vector-take-while-right)
(rename vector-drop-while c64vector-drop-while)
(rename vector-drop-while-right c64vector-drop-while-right)
(rename vector-index c64vector-index)
(rename vector-index-right c64vector-index-right)
(rename vector-skip c64vector-skip)
(rename vector-skip-right c64vector-skip-right)
(rename vector-binary-search c64vector-binary-search)
(rename vector-any c64vector-any)
(rename vector-every c64vector-every)
(rename vector-partition c64vector-partition)
(rename vector-filter c64vector-filter)
(rename vector-remove c64vector-remove)
(rename vector-swap! c64vector-swap!)
(rename vector-fill! c64vector-fill!)
(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)
(rename make-vector-generator make-c64vector-generator)
(rename write-vector write-c64vector))
(import (except (scheme base)
vector-append vector-copy vector-copy!
vector-map vector-for-each)
(scheme write)
(srfi 160 base))
(begin
(define uvector? c64vector?)
(define make-uvector make-c64vector)
(define uvector-length c64vector-length)
(define uvector-ref c64vector-ref)
(define uvector-set! c64vector-set!))
(include "uvector.scm"))

70
lib/srfi/160/f32.sld Normal file
View file

@ -0,0 +1,70 @@
(define-library (srfi 160 f32)
(export
make-f32vector
f32?
f32vector?
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)
(rename vector-reverse-copy f32vector-reverse-copy)
(rename vector-append f32vector-append)
(rename vector-concatenate f32vector-concatenate)
(rename vector-append-subvectors f32vector-append-subvectors)
(rename vector-empty? f32vector-empty?)
(rename vector= f32vector=)
(rename vector-take f32vector-take)
(rename vector-take-right f32vector-take-right)
(rename vector-drop f32vector-drop)
(rename vector-drop-right f32vector-drop-right)
(rename vector-segment f32vector-segment)
(rename vector-fold f32vector-fold)
(rename vector-fold-right f32vector-fold-right)
(rename vector-map f32vector-map)
(rename vector-map! f32vector-map!)
(rename vector-for-each f32vector-for-each)
(rename vector-count f32vector-count)
(rename vector-cumulate f32vector-cumulate)
(rename vector-take-while f32vector-take-while)
(rename vector-take-while-right f32vector-take-while-right)
(rename vector-drop-while f32vector-drop-while)
(rename vector-drop-while-right f32vector-drop-while-right)
(rename vector-index f32vector-index)
(rename vector-index-right f32vector-index-right)
(rename vector-skip f32vector-skip)
(rename vector-skip-right f32vector-skip-right)
(rename vector-binary-search f32vector-binary-search)
(rename vector-any f32vector-any)
(rename vector-every f32vector-every)
(rename vector-partition f32vector-partition)
(rename vector-filter f32vector-filter)
(rename vector-remove f32vector-remove)
(rename vector-swap! f32vector-swap!)
(rename vector-fill! f32vector-fill!)
(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)
(rename make-vector-generator make-f32vector-generator)
(rename write-vector write-f32vector))
(import (except (scheme base)
vector-append vector-copy vector-copy!
vector-map vector-for-each)
(scheme write)
(srfi 160 base))
(begin
(define uvector? f32vector?)
(define make-uvector make-f32vector)
(define uvector-length f32vector-length)
(define uvector-ref f32vector-ref)
(define uvector-set! f32vector-set!))
(include "uvector.scm"))

70
lib/srfi/160/f64.sld Normal file
View file

@ -0,0 +1,70 @@
(define-library (srfi 160 f64)
(export
make-f64vector
f64?
f64vector?
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)
(rename vector-reverse-copy f64vector-reverse-copy)
(rename vector-append f64vector-append)
(rename vector-concatenate f64vector-concatenate)
(rename vector-append-subvectors f64vector-append-subvectors)
(rename vector-empty? f64vector-empty?)
(rename vector= f64vector=)
(rename vector-take f64vector-take)
(rename vector-take-right f64vector-take-right)
(rename vector-drop f64vector-drop)
(rename vector-drop-right f64vector-drop-right)
(rename vector-segment f64vector-segment)
(rename vector-fold f64vector-fold)
(rename vector-fold-right f64vector-fold-right)
(rename vector-map f64vector-map)
(rename vector-map! f64vector-map!)
(rename vector-for-each f64vector-for-each)
(rename vector-count f64vector-count)
(rename vector-cumulate f64vector-cumulate)
(rename vector-take-while f64vector-take-while)
(rename vector-take-while-right f64vector-take-while-right)
(rename vector-drop-while f64vector-drop-while)
(rename vector-drop-while-right f64vector-drop-while-right)
(rename vector-index f64vector-index)
(rename vector-index-right f64vector-index-right)
(rename vector-skip f64vector-skip)
(rename vector-skip-right f64vector-skip-right)
(rename vector-binary-search f64vector-binary-search)
(rename vector-any f64vector-any)
(rename vector-every f64vector-every)
(rename vector-partition f64vector-partition)
(rename vector-filter f64vector-filter)
(rename vector-remove f64vector-remove)
(rename vector-swap! f64vector-swap!)
(rename vector-fill! f64vector-fill!)
(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)
(rename make-vector-generator make-f64vector-generator)
(rename write-vector write-f64vector))
(import (except (scheme base)
vector-append vector-copy vector-copy!
vector-map vector-for-each)
(scheme write)
(srfi 160 base))
(begin
(define uvector? f64vector?)
(define make-uvector make-f64vector)
(define uvector-length f64vector-length)
(define uvector-ref f64vector-ref)
(define uvector-set! f64vector-set!))
(include "uvector.scm"))

70
lib/srfi/160/s16.sld Normal file
View file

@ -0,0 +1,70 @@
(define-library (srfi 160 s16)
(export
make-s16vector
s16?
s16vector?
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)
(rename vector-reverse-copy s16vector-reverse-copy)
(rename vector-append s16vector-append)
(rename vector-concatenate s16vector-concatenate)
(rename vector-append-subvectors s16vector-append-subvectors)
(rename vector-empty? s16vector-empty?)
(rename vector= s16vector=)
(rename vector-take s16vector-take)
(rename vector-take-right s16vector-take-right)
(rename vector-drop s16vector-drop)
(rename vector-drop-right s16vector-drop-right)
(rename vector-segment s16vector-segment)
(rename vector-fold s16vector-fold)
(rename vector-fold-right s16vector-fold-right)
(rename vector-map s16vector-map)
(rename vector-map! s16vector-map!)
(rename vector-for-each s16vector-for-each)
(rename vector-count s16vector-count)
(rename vector-cumulate s16vector-cumulate)
(rename vector-take-while s16vector-take-while)
(rename vector-take-while-right s16vector-take-while-right)
(rename vector-drop-while s16vector-drop-while)
(rename vector-drop-while-right s16vector-drop-while-right)
(rename vector-index s16vector-index)
(rename vector-index-right s16vector-index-right)
(rename vector-skip s16vector-skip)
(rename vector-skip-right s16vector-skip-right)
(rename vector-binary-search s16vector-binary-search)
(rename vector-any s16vector-any)
(rename vector-every s16vector-every)
(rename vector-partition s16vector-partition)
(rename vector-filter s16vector-filter)
(rename vector-remove s16vector-remove)
(rename vector-swap! s16vector-swap!)
(rename vector-fill! s16vector-fill!)
(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)
(rename make-vector-generator make-s16vector-generator)
(rename write-vector write-s16vector))
(import (except (scheme base)
vector-append vector-copy vector-copy!
vector-map vector-for-each)
(scheme write)
(srfi 160 base))
(begin
(define uvector? s16vector?)
(define make-uvector make-s16vector)
(define uvector-length s16vector-length)
(define uvector-ref s16vector-ref)
(define uvector-set! s16vector-set!))
(include "uvector.scm"))

70
lib/srfi/160/s32.sld Normal file
View file

@ -0,0 +1,70 @@
(define-library (srfi 160 s32)
(export
make-s32vector
s32?
s32vector?
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)
(rename vector-reverse-copy s32vector-reverse-copy)
(rename vector-append s32vector-append)
(rename vector-concatenate s32vector-concatenate)
(rename vector-append-subvectors s32vector-append-subvectors)
(rename vector-empty? s32vector-empty?)
(rename vector= s32vector=)
(rename vector-take s32vector-take)
(rename vector-take-right s32vector-take-right)
(rename vector-drop s32vector-drop)
(rename vector-drop-right s32vector-drop-right)
(rename vector-segment s32vector-segment)
(rename vector-fold s32vector-fold)
(rename vector-fold-right s32vector-fold-right)
(rename vector-map s32vector-map)
(rename vector-map! s32vector-map!)
(rename vector-for-each s32vector-for-each)
(rename vector-count s32vector-count)
(rename vector-cumulate s32vector-cumulate)
(rename vector-take-while s32vector-take-while)
(rename vector-take-while-right s32vector-take-while-right)
(rename vector-drop-while s32vector-drop-while)
(rename vector-drop-while-right s32vector-drop-while-right)
(rename vector-index s32vector-index)
(rename vector-index-right s32vector-index-right)
(rename vector-skip s32vector-skip)
(rename vector-skip-right s32vector-skip-right)
(rename vector-binary-search s32vector-binary-search)
(rename vector-any s32vector-any)
(rename vector-every s32vector-every)
(rename vector-partition s32vector-partition)
(rename vector-filter s32vector-filter)
(rename vector-remove s32vector-remove)
(rename vector-swap! s32vector-swap!)
(rename vector-fill! s32vector-fill!)
(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)
(rename make-vector-generator make-s32vector-generator)
(rename write-vector write-s32vector))
(import (except (scheme base)
vector-append vector-copy vector-copy!
vector-map vector-for-each)
(scheme write)
(srfi 160 base))
(begin
(define uvector? s32vector?)
(define make-uvector make-s32vector)
(define uvector-length s32vector-length)
(define uvector-ref s32vector-ref)
(define uvector-set! s32vector-set!))
(include "uvector.scm"))

70
lib/srfi/160/s64.sld Normal file
View file

@ -0,0 +1,70 @@
(define-library (srfi 160 s64)
(export
make-s64vector
s64?
s64vector?
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)
(rename vector-reverse-copy s64vector-reverse-copy)
(rename vector-append s64vector-append)
(rename vector-concatenate s64vector-concatenate)
(rename vector-append-subvectors s64vector-append-subvectors)
(rename vector-empty? s64vector-empty?)
(rename vector= s64vector=)
(rename vector-take s64vector-take)
(rename vector-take-right s64vector-take-right)
(rename vector-drop s64vector-drop)
(rename vector-drop-right s64vector-drop-right)
(rename vector-segment s64vector-segment)
(rename vector-fold s64vector-fold)
(rename vector-fold-right s64vector-fold-right)
(rename vector-map s64vector-map)
(rename vector-map! s64vector-map!)
(rename vector-for-each s64vector-for-each)
(rename vector-count s64vector-count)
(rename vector-cumulate s64vector-cumulate)
(rename vector-take-while s64vector-take-while)
(rename vector-take-while-right s64vector-take-while-right)
(rename vector-drop-while s64vector-drop-while)
(rename vector-drop-while-right s64vector-drop-while-right)
(rename vector-index s64vector-index)
(rename vector-index-right s64vector-index-right)
(rename vector-skip s64vector-skip)
(rename vector-skip-right s64vector-skip-right)
(rename vector-binary-search s64vector-binary-search)
(rename vector-any s64vector-any)
(rename vector-every s64vector-every)
(rename vector-partition s64vector-partition)
(rename vector-filter s64vector-filter)
(rename vector-remove s64vector-remove)
(rename vector-swap! s64vector-swap!)
(rename vector-fill! s64vector-fill!)
(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)
(rename make-vector-generator make-s64vector-generator)
(rename write-vector write-s64vector))
(import (except (scheme base)
vector-append vector-copy vector-copy!
vector-map vector-for-each)
(scheme write)
(srfi 160 base))
(begin
(define uvector? s64vector?)
(define make-uvector make-s64vector)
(define uvector-length s64vector-length)
(define uvector-ref s64vector-ref)
(define uvector-set! s64vector-set!))
(include "uvector.scm"))

70
lib/srfi/160/s8.sld Normal file
View file

@ -0,0 +1,70 @@
(define-library (srfi 160 s8)
(export
make-s8vector
s8?
s8vector?
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)
(rename vector-reverse-copy s8vector-reverse-copy)
(rename vector-append s8vector-append)
(rename vector-concatenate s8vector-concatenate)
(rename vector-append-subvectors s8vector-append-subvectors)
(rename vector-empty? s8vector-empty?)
(rename vector= s8vector=)
(rename vector-take s8vector-take)
(rename vector-take-right s8vector-take-right)
(rename vector-drop s8vector-drop)
(rename vector-drop-right s8vector-drop-right)
(rename vector-segment s8vector-segment)
(rename vector-fold s8vector-fold)
(rename vector-fold-right s8vector-fold-right)
(rename vector-map s8vector-map)
(rename vector-map! s8vector-map!)
(rename vector-for-each s8vector-for-each)
(rename vector-count s8vector-count)
(rename vector-cumulate s8vector-cumulate)
(rename vector-take-while s8vector-take-while)
(rename vector-take-while-right s8vector-take-while-right)
(rename vector-drop-while s8vector-drop-while)
(rename vector-drop-while-right s8vector-drop-while-right)
(rename vector-index s8vector-index)
(rename vector-index-right s8vector-index-right)
(rename vector-skip s8vector-skip)
(rename vector-skip-right s8vector-skip-right)
(rename vector-binary-search s8vector-binary-search)
(rename vector-any s8vector-any)
(rename vector-every s8vector-every)
(rename vector-partition s8vector-partition)
(rename vector-filter s8vector-filter)
(rename vector-remove s8vector-remove)
(rename vector-swap! s8vector-swap!)
(rename vector-fill! s8vector-fill!)
(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)
(rename make-vector-generator make-s8vector-generator)
(rename write-vector write-s8vector))
(import (except (scheme base)
vector-append vector-copy vector-copy!
vector-map vector-for-each)
(scheme write)
(srfi 160 base))
(begin
(define uvector? s8vector?)
(define make-uvector make-s8vector)
(define uvector-length s8vector-length)
(define uvector-ref s8vector-ref)
(define uvector-set! s8vector-set!))
(include "uvector.scm"))

148
lib/srfi/160/test.sld Normal file
View file

@ -0,0 +1,148 @@
(define-library (srfi 160 test)
(import (scheme base) (srfi 160 u32) (chibi test))
(export run-tests)
(begin
(define (run-tests)
(test-begin "srfi-160: uniform vectors")
(test-group "uvectors/constructors"
(define a2i '#u32(0 1 2 3 4 5 6 7 8))
(test '#u32(0 1 2 3 4) (u32vector 0 1 2 3 4))
(test '#u32(0 1 2 3 4 5 6 7 8 9)
(u32vector-unfold (lambda (i x) (values x (+ x 1))) 10 0))
(test '#u32(0 1 2 3 4 5 6) (u32vector-unfold values 7))
;; (test '#u32((0 . 4) (1 . 3) (2 . 2) (3 . 1) (4 . 0))
;; (u32vector-unfold-right (lambda (i x) (values (cons i x) (+ x 1))) 5 0))
(test a2i (u32vector-copy a2i))
(test-assert (not (eqv? a2i (u32vector-copy a2i))))
(test '#u32(6 7 8) (u32vector-copy a2i 6))
(test '#u32(3 4 5) (u32vector-copy a2i 3 6))
(test '#u32(1 2 3 4) (u32vector-reverse-copy '#u32(5 4 3 2 1 0) 1 5))
(test '#u32(0 1) (u32vector-append '#u32(0) '#u32(1)))
(test '#u32(0 1 2 3) (u32vector-append '#u32(0) '#u32(1 2 3)))
(test '#u32(0 1 2 3) (u32vector-concatenate '(#u32(0 1) #u32(2 3))))
(test '#u32(0 1 6 7)
(u32vector-append-subvectors '#u32(0 1 2 3 4) 0 2 '#u32(4 5 6 7 8) 2 4))
)
(test-group "uvectors/predicates"
(test #f (u32vector-empty? '#u32(0)))
(test-assert (u32vector-empty? '#u32()))
(test-assert (u32vector= eq? '#u32(0 1 2 3) '#u32(0 1 2 3)))
(test #t (u32vector= eq? '#u32(0 1 2 3) '#u32(0 1 2 3)))
(test #f (u32vector= = '#u32(1 2 3 4 5) '#u32(1 2 3 4)))
(test-assert (u32vector= eq?))
(test-assert (u32vector= eq? '#u32(0)))
(test-assert (u32vector= equal? (u32vector 0) (u32vector 0)))
)
(test-group "uvectors/iteration"
(define vec '#u32(0 1 2 3 4 5))
(define vec2 (u32vector 0 1 2 3 4))
(define vec3 (u32vector 1 2 3 4 5))
(test '(5 4 3 2 1 0)
(u32vector-fold (lambda (tail elt) (cons elt tail)) '() vec))
(test 3 (u32vector-fold (lambda (ctr n) (if (even? n) (+ ctr 1) ctr)) 0 vec))
(test '(0 1 2 3) (u32vector-fold-right (lambda (tail elt) (cons elt tail))
'() '#u32(0 1 2 3)))
(test '#u32(1 4 9 16) (u32vector-map square '#u32(1 2 3 4)))
(test '#u32(5 8 9 8 5) (u32vector-map * '#u32(1 2 3 4 5) '#u32(5 4 3 2 1)))
(u32vector-map! square vec2)
(test '#u32(0 1 4 9 16) (u32vector-copy vec2))
(u32vector-map! * vec2 vec3)
(test '#u32(0 2 12 36 80) (u32vector-copy vec2))
(let ((result '()))
(u32vector-for-each (lambda (x) (set! result (cons x result))) vec)
(test '(5 4 3 2 1 0) result))
(test 3 (u32vector-count even? '#u32(3 1 4 1 5 9 2 5 6)))
(test 2 (u32vector-count < '#u32(1 3 6 9) '#u32(2 4 6 8 10 12)))
(test '#u32(3 4 8 9 14 23 25 30 36) (u32vector-cumulate + 0 '#u32(3 1 4 1 5 9 2 5 6)))
)
(test-group "uvectors/searching"
(define (cmp a b)
(cond
((< a b) -1)
((= a b) 0)
(else 1)))
(define v '#u32(0 2 4 6 8 10 12))
(test 2 (u32vector-index even? '#u32(3 1 4 1 5 9 6)))
(test 5 (u32vector-index-right odd? '#u32(3 1 4 1 5 9 6)))
(test 2 (u32vector-skip odd? '#u32(1 3 2 5 7 1 1 8 9)))
(test 7 (u32vector-skip-right odd? '#u32(1 3 2 5 7 1 1 8 9)))
(test 0 (u32vector-binary-search v 0 cmp))
(test 3 (u32vector-binary-search v 6 cmp))
(test #f (u32vector-binary-search v 1 cmp))
(test-assert (u32vector-any even? '#u32(1 2 3 4 5)))
(test-assert (u32vector-any < '#u32(1 2 3 4 5) '#u32(2 1 3 4 5)))
(test #f (u32vector-any odd? '#u32(2 4 6 8)))
(test #f (u32vector-any > '#u32(1 2 3 4 5) '#u32(1 2 3 4 5)))
(test #f (u32vector-every odd? '#u32(1 2 3 4 5)))
(test-assert (u32vector-every number? '#u32(1 2 3 4 5)))
(test #f (u32vector-every < '#u32(1 2 3) '#u32(2 3 3)))
(test-assert (u32vector-every < '#u32(1 2 3) '#u32(2 3 4)))
(test 'yes (u32vector-any (lambda (x) (if (even? x) 'yes #f)) '#u32(1 3 2 5 7)))
(let-values (((new off) (u32vector-partition odd? '#u32(1 2 3 4 5 6))))
(test '#u32(1 3 5 2 4 6) (u32vector-copy new))
(test 3 off))
)
(test-group "uvectors/mutation"
(define vs (u32vector 1 2 3))
(define vf0 (u32vector 1 2 3))
(define vf1 (u32vector 1 2 3))
(define vf2 (u32vector 1 2 3))
(define vr0 (u32vector 1 2 3))
(define vr1 (u32vector 1 2 3))
(define vr2 (u32vector 1 2 3))
(define vc0 (u32vector 1 2 3 4 5))
(define vc1 (u32vector 1 2 3 4 5))
(define vc2 (u32vector 1 2 3 4 5))
(define vrc0 (u32vector 1 2 3 4 5))
(define vrc1 (u32vector 1 2 3 4 5))
(define vrc2 (u32vector 1 2 3 4 5))
(define vu0 (u32vector 1 2 3 4 5))
(define vu1 (u32vector 1 2 3 4 5))
(define vu2 (u32vector 1 2 3 4 5))
(define vur0 (u32vector 1 2 3 4 5))
(define vur1 (u32vector 1 2 3 4 5))
(define vur2 (u32vector 1 2 3 4 5))
(u32vector-swap! vs 0 1)
(test '#u32(2 1 3) (u32vector-copy vs))
(u32vector-fill! vf0 0)
(test '#u32(0 0 0) (u32vector-copy vf0))
(u32vector-fill! vf1 0 1)
(test '#u32(1 0 0) (u32vector-copy vf1))
(u32vector-fill! vf2 0 0 1)
(test '#u32(0 2 3) (u32vector-copy vf2))
(u32vector-reverse! vr0)
(test '#u32(3 2 1) (u32vector-copy vr0))
(u32vector-reverse! vr1 1)
(test '#u32(1 3 2) (u32vector-copy vr1))
(u32vector-reverse! vr2 0 2)
(test '#u32(2 1 3) (u32vector-copy vr2))
(u32vector-copy! vc0 1 '#u32(10 20 30))
(test '#u32(1 10 20 30 5) (u32vector-copy vc0))
(u32vector-copy! vc1 1 '#u32(0 10 20 30 40) 1)
(test '#u32(1 10 20 30 40) (u32vector-copy vc1))
(u32vector-copy! vc2 1 '#u32(0 10 20 30 40) 1 4)
(test '#u32(1 10 20 30 5) (u32vector-copy vc2))
(u32vector-reverse-copy! vrc0 1 '#u32(10 20 30))
(test '#u32(1 30 20 10 5) (u32vector-copy vrc0))
(u32vector-reverse-copy! vrc1 1 '#u32(0 10 20 30 40) 1)
(test '#u32(1 40 30 20 10) (u32vector-copy vrc1))
(u32vector-reverse-copy! vrc2 1 '#u32(0 10 20 30 40) 1 4)
(test '#u32(1 30 20 10 5) (u32vector-copy vrc2))
)
(test-group "uvectors/conversion"
(test '(1 2 3) (u32vector->list '#u32(1 2 3)))
(test '(2 3) (u32vector->list '#u32(1 2 3) 1))
(test '(1 2) (u32vector->list '#u32(1 2 3) 0 2))
(test '#u32(1 2 3) (list->u32vector '(1 2 3)))
(test '(3 2 1) (reverse-u32vector->list '#u32(1 2 3)))
(test '(3 2) (reverse-u32vector->list '#u32(1 2 3) 1))
(test '(2 1) (reverse-u32vector->list '#u32(1 2 3) 0 2))
(test '#u32(3 2 1) (reverse-list->u32vector '(1 2 3)))
)
(test-end))))

70
lib/srfi/160/u16.sld Normal file
View file

@ -0,0 +1,70 @@
(define-library (srfi 160 u16)
(export
make-u16vector
u16?
u16vector?
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)
(rename vector-reverse-copy u16vector-reverse-copy)
(rename vector-append u16vector-append)
(rename vector-concatenate u16vector-concatenate)
(rename vector-append-subvectors u16vector-append-subvectors)
(rename vector-empty? u16vector-empty?)
(rename vector= u16vector=)
(rename vector-take u16vector-take)
(rename vector-take-right u16vector-take-right)
(rename vector-drop u16vector-drop)
(rename vector-drop-right u16vector-drop-right)
(rename vector-segment u16vector-segment)
(rename vector-fold u16vector-fold)
(rename vector-fold-right u16vector-fold-right)
(rename vector-map u16vector-map)
(rename vector-map! u16vector-map!)
(rename vector-for-each u16vector-for-each)
(rename vector-count u16vector-count)
(rename vector-cumulate u16vector-cumulate)
(rename vector-take-while u16vector-take-while)
(rename vector-take-while-right u16vector-take-while-right)
(rename vector-drop-while u16vector-drop-while)
(rename vector-drop-while-right u16vector-drop-while-right)
(rename vector-index u16vector-index)
(rename vector-index-right u16vector-index-right)
(rename vector-skip u16vector-skip)
(rename vector-skip-right u16vector-skip-right)
(rename vector-binary-search u16vector-binary-search)
(rename vector-any u16vector-any)
(rename vector-every u16vector-every)
(rename vector-partition u16vector-partition)
(rename vector-filter u16vector-filter)
(rename vector-remove u16vector-remove)
(rename vector-swap! u16vector-swap!)
(rename vector-fill! u16vector-fill!)
(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)
(rename make-vector-generator make-u16vector-generator)
(rename write-vector write-u16vector))
(import (except (scheme base)
vector-append vector-copy vector-copy!
vector-map vector-for-each)
(scheme write)
(srfi 160 base))
(begin
(define uvector? u16vector?)
(define make-uvector make-u16vector)
(define uvector-length u16vector-length)
(define uvector-ref u16vector-ref)
(define uvector-set! u16vector-set!))
(include "uvector.scm"))

70
lib/srfi/160/u32.sld Normal file
View file

@ -0,0 +1,70 @@
(define-library (srfi 160 u32)
(export
make-u32vector
u32?
u32vector?
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)
(rename vector-reverse-copy u32vector-reverse-copy)
(rename vector-append u32vector-append)
(rename vector-concatenate u32vector-concatenate)
(rename vector-append-subvectors u32vector-append-subvectors)
(rename vector-empty? u32vector-empty?)
(rename vector= u32vector=)
(rename vector-take u32vector-take)
(rename vector-take-right u32vector-take-right)
(rename vector-drop u32vector-drop)
(rename vector-drop-right u32vector-drop-right)
(rename vector-segment u32vector-segment)
(rename vector-fold u32vector-fold)
(rename vector-fold-right u32vector-fold-right)
(rename vector-map u32vector-map)
(rename vector-map! u32vector-map!)
(rename vector-for-each u32vector-for-each)
(rename vector-count u32vector-count)
(rename vector-cumulate u32vector-cumulate)
(rename vector-take-while u32vector-take-while)
(rename vector-take-while-right u32vector-take-while-right)
(rename vector-drop-while u32vector-drop-while)
(rename vector-drop-while-right u32vector-drop-while-right)
(rename vector-index u32vector-index)
(rename vector-index-right u32vector-index-right)
(rename vector-skip u32vector-skip)
(rename vector-skip-right u32vector-skip-right)
(rename vector-binary-search u32vector-binary-search)
(rename vector-any u32vector-any)
(rename vector-every u32vector-every)
(rename vector-partition u32vector-partition)
(rename vector-filter u32vector-filter)
(rename vector-remove u32vector-remove)
(rename vector-swap! u32vector-swap!)
(rename vector-fill! u32vector-fill!)
(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)
(rename make-vector-generator make-u32vector-generator)
(rename write-vector write-u32vector))
(import (except (scheme base)
vector-append vector-copy vector-copy!
vector-map vector-for-each)
(scheme write)
(srfi 160 base))
(begin
(define uvector? u32vector?)
(define make-uvector make-u32vector)
(define uvector-length u32vector-length)
(define uvector-ref u32vector-ref)
(define uvector-set! u32vector-set!))
(include "uvector.scm"))

70
lib/srfi/160/u64.sld Normal file
View file

@ -0,0 +1,70 @@
(define-library (srfi 160 s64)
(export
make-s64vector
s64?
s64vector?
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)
(rename vector-reverse-copy s64vector-reverse-copy)
(rename vector-append s64vector-append)
(rename vector-concatenate s64vector-concatenate)
(rename vector-append-subvectors s64vector-append-subvectors)
(rename vector-empty? s64vector-empty?)
(rename vector= s64vector=)
(rename vector-take s64vector-take)
(rename vector-take-right s64vector-take-right)
(rename vector-drop s64vector-drop)
(rename vector-drop-right s64vector-drop-right)
(rename vector-segment s64vector-segment)
(rename vector-fold s64vector-fold)
(rename vector-fold-right s64vector-fold-right)
(rename vector-map s64vector-map)
(rename vector-map! s64vector-map!)
(rename vector-for-each s64vector-for-each)
(rename vector-count s64vector-count)
(rename vector-cumulate s64vector-cumulate)
(rename vector-take-while s64vector-take-while)
(rename vector-take-while-right s64vector-take-while-right)
(rename vector-drop-while s64vector-drop-while)
(rename vector-drop-while-right s64vector-drop-while-right)
(rename vector-index s64vector-index)
(rename vector-index-right s64vector-index-right)
(rename vector-skip s64vector-skip)
(rename vector-skip-right s64vector-skip-right)
(rename vector-binary-search s64vector-binary-search)
(rename vector-any s64vector-any)
(rename vector-every s64vector-every)
(rename vector-partition s64vector-partition)
(rename vector-filter s64vector-filter)
(rename vector-remove s64vector-remove)
(rename vector-swap! s64vector-swap!)
(rename vector-fill! s64vector-fill!)
(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)
(rename make-vector-generator make-s64vector-generator)
(rename write-vector write-s64vector))
(import (except (scheme base)
vector-append vector-copy vector-copy!
vector-map vector-for-each)
(scheme write)
(srfi 160 base))
(begin
(define uvector? s64vector?)
(define make-uvector make-s64vector)
(define uvector-length s64vector-length)
(define uvector-ref s64vector-ref)
(define uvector-set! s64vector-set!))
(include "uvector.scm"))

70
lib/srfi/160/u8.sld Normal file
View file

@ -0,0 +1,70 @@
(define-library (srfi 160 u8)
(export
make-u8vector
u8?
u8vector?
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)
(rename vector-reverse-copy u8vector-reverse-copy)
(rename vector-append u8vector-append)
(rename vector-concatenate u8vector-concatenate)
(rename vector-append-subvectors u8vector-append-subvectors)
(rename vector-empty? u8vector-empty?)
(rename vector= u8vector=)
(rename vector-take u8vector-take)
(rename vector-take-right u8vector-take-right)
(rename vector-drop u8vector-drop)
(rename vector-drop-right u8vector-drop-right)
(rename vector-segment u8vector-segment)
(rename vector-fold u8vector-fold)
(rename vector-fold-right u8vector-fold-right)
(rename vector-map u8vector-map)
(rename vector-map! u8vector-map!)
(rename vector-for-each u8vector-for-each)
(rename vector-count u8vector-count)
(rename vector-cumulate u8vector-cumulate)
(rename vector-take-while u8vector-take-while)
(rename vector-take-while-right u8vector-take-while-right)
(rename vector-drop-while u8vector-drop-while)
(rename vector-drop-while-right u8vector-drop-while-right)
(rename vector-index u8vector-index)
(rename vector-index-right u8vector-index-right)
(rename vector-skip u8vector-skip)
(rename vector-skip-right u8vector-skip-right)
(rename vector-binary-search u8vector-binary-search)
(rename vector-any u8vector-any)
(rename vector-every u8vector-every)
(rename vector-partition u8vector-partition)
(rename vector-filter u8vector-filter)
(rename vector-remove u8vector-remove)
(rename vector-swap! u8vector-swap!)
(rename vector-fill! u8vector-fill!)
(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)
(rename make-vector-generator make-u8vector-generator)
(rename write-vector write-u8vector))
(import (except (scheme base)
vector-append vector-copy vector-copy!
vector-map vector-for-each)
(scheme write)
(srfi 160 base))
(begin
(define uvector? u8vector?)
(define make-uvector make-u8vector)
(define uvector-length u8vector-length)
(define uvector-ref u8vector-ref)
(define uvector-set! u8vector-set!))
(include "uvector.scm"))

339
lib/srfi/160/uvector.scm Normal file
View file

@ -0,0 +1,339 @@
(define (vector-empty? vec)
(zero? (uvector-length vec)))
(define (vector= eq . o)
(cond
((null? o) #t)
((null? (cdr o)) #t)
(else
(and (let* ((v1 (car o))
(v2 (cadr o))
(len (uvector-length v1)))
(and (= len (uvector-length v2))
(let lp ((i 0))
(or (>= i len)
(and (eq (uvector-ref v1 i)
(uvector-ref v2 i))
(lp (+ i 1)))))))
(apply vector= eq (cdr o))))))
(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 . o)
(let ((res (make-uvector len)))
(let lp ((i 0) (seeds o))
(if (>= i len)
res
(call-with-values (lambda () (apply f i seeds))
(lambda (x . seeds)
(uvector-set! res i x)
(lp (+ i 1) seeds)))))))
(define (uvector-unfold-right f len . o)
(let ((res (make-uvector len)))
(let lp ((i (- len 1)) (seeds o))
(if (< i 0)
res
(call-with-values (lambda () (apply f i seeds))
(lambda (x . seeds)
(uvector-set! res i x)
(lp (- i 1) seeds)))))))
(define (vector-copy vec . o)
(let ((start (if (pair? o) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o)))
(cadr o)
(uvector-length vec))))
(uvector-unfold (lambda (i) (uvector-ref vec (+ i start)))
(- end start))))
(define (vector-reverse-copy vec . o)
(let ((start (if (pair? o) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o)))
(cadr o)
(uvector-length vec))))
(uvector-unfold (lambda (i) (uvector-ref vec (- end (+ i start))))
(- end start))))
(define (vector-concatenate vecs)
(let* ((len (apply + (map uvector-length vecs)))
(res (make-uvector len)))
(let lp ((ls vecs) (i 0))
(if (null? ls)
res
(let ((v-len (uvector-length (car ls))))
(vector-copy! res i (car ls))
(lp (cdr ls) (+ i v-len)))))))
(define (vector-append . vecs)
(vector-concatenate vecs))
(define (vector-append-subvectors . o)
(let lp ((ls o) (vecs '()))
(if (null? ls)
(vector-concatenate (reverse vecs))
(lp (cdr (cddr ls))
(cons (vector-copy (car ls) (cadr ls) (car (cddr ls)))
vecs)))))
(define (vector-fill! vec x . o)
(let ((start (if (pair? o) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o)))
(cadr o)
(uvector-length vec))))
(let lp ((i (- end 1)))
(when (>= i start)
(uvector-set! vec i x)
(lp (- i 1))))))
(define (vector-swap! vec i j)
(let ((tmp (uvector-ref vec i)))
(uvector-set! vec i (uvector-ref vec j))
(uvector-set! vec j tmp)))
(define (vector-reverse! vec . o)
(let lp ((left (if (pair? o) (car o) 0))
(right (- (if (and (pair? o) (pair? (cdr o)))
(cadr o)
(uvector-length vec))
1)))
(cond
((>= left right) (if #f #f))
(else
(vector-swap! vec left right)
(lp (+ left 1) (- right 1))))))
(define (vector-copy! to at from . o)
(let* ((start (if (pair? o) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o)))
(cadr o)
(uvector-length from)))
(limit (min end (+ start (- (uvector-length to) at)))))
(if (<= at start)
(do ((i at (+ i 1)) (j start (+ j 1)))
((>= j limit))
(uvector-set! to i (uvector-ref from j)))
(do ((i (+ at (- end start 1)) (- i 1))
(j (- limit 1) (- j 1)))
((< j start))
(uvector-set! to i (uvector-ref from j))))))
(define (vector-reverse-copy! to at from . o)
(let ((start (if (pair? o) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o)))
(cadr o)
(uvector-length from))))
(vector-copy! to at from start end)
(vector-reverse! to at (+ at (- end start)))))
(define (vector-take vec n)
(vector-copy vec 0 n))
(define (vector-take-right vec n)
(vector-copy vec (- (uvector-length vec) n)))
(define (vector-drop vec n)
(vector-copy vec n))
(define (vector-drop-right vec n)
(vector-copy vec 0 (- (uvector-length vec) n)))
(define (vector-segment vec n)
(let ((len (uvector-length vec)))
(let lp ((i 0) (res '()))
(let ((diff (- len i)))
(if (zero? diff)
(reverse res)
(lp (max (+ i n) len)
(cons (vector-copy vec i n) res)))))))
(define (vector-fold kons knil vec1 . o)
(let ((len (uvector-length vec1)))
(if (null? o)
(let lp ((i 0) (acc knil))
(if (>= i len)
acc
(lp (+ i 1) (kons acc (uvector-ref vec1 i)))))
(let lp ((i 0) (acc knil))
(if (>= i len)
acc
(lp (+ i 1)
(apply kons acc (uvector-ref vec1 i)
(map (lambda (v) (uvector-ref v i)) o))))))))
(define (vector-fold-right kons knil vec1 . o)
(let ((len (uvector-length vec1)))
(if (null? o)
(let lp ((i (- len 1)) (acc knil))
(if (negative? i)
acc
(lp (- i 1) (kons acc (uvector-ref vec1 i)))))
(let lp ((i (- len 1)) (acc knil))
(if (negative? i)
acc
(lp (- i 1)
(apply kons acc (uvector-ref vec1 i)
(map (lambda (v) (uvector-ref v i)) o))))))))
(define (vector-map! f vec1 . o)
(apply vector-fold
(lambda (i . o)
(uvector-set! vec1 i (apply f o))
(+ i 1))
0 vec1 o))
(define (vector-map f vec1 . o)
(let ((res (vector-copy vec1)))
(apply vector-map! f res o)
res))
(define (vector-for-each f vec1 . o)
(apply vector-fold (lambda (acc . o) (apply f o) acc) (if #f #f) vec1 o))
(define (vector-count f vec1 . o)
(apply vector-fold
(lambda (sum . o) (+ sum (if (apply f o) 1 0)))
0 vec1 o))
(define (vector-cumulate f knil vec)
(let* ((len (uvector-length vec))
(res (make-uvector len)))
(let lp ((i 0) (acc knil))
(if (>= i len)
res
(let ((acc (f acc (uvector-ref vec i))))
(uvector-set! res i acc)
(lp (+ i 1) acc))))))
(define (vector-index pred vec)
(let ((len (uvector-length vec)))
(let lp ((i 0))
(cond ((>= i len) #f)
((pred (uvector-ref vec i)) i)
(else (lp (+ i 1)))))))
(define (vector-index-right pred vec)
(let lp ((i (- (uvector-length vec) 1)))
(cond ((negative? i) #f)
((pred (uvector-ref vec i)) i)
(else (lp (- i 1))))))
(define (vector-skip pred vec)
(vector-index (lambda (x) (not (pred x))) vec))
(define (vector-skip-right pred vec)
(vector-index-right (lambda (x) (not (pred x))) vec))
(define (vector-take-while vec pred)
(vector-copy vec 0 (or (vector-skip pred vec)
(uvector-length vec))))
(define (vector-take-while-right vec pred)
(vector-copy vec (or (vector-skip-right pred vec) 0)))
(define (vector-drop-while vec pred)
(vector-copy vec (or (vector-index pred vec) 0)))
(define (vector-drop-while-right vec pred)
(vector-copy vec 0 (or (vector-index-right pred vec)
(uvector-length vec))))
(define (vector-binary-search vec value cmp)
(let lp ((lo 0) (hi (- (uvector-length vec) 1)))
(and (<= lo hi)
(let* ((mid (quotient (+ lo hi) 2))
(x (uvector-ref vec mid))
(y (cmp value x)))
(cond
((< y 0) (lp lo (- mid 1)))
((> y 0) (lp (+ mid 1) hi))
(else mid))))))
(define (vector-any pred? vec1 . o)
(let ((len (apply min (uvector-length vec1)
(map uvector-length o))))
(let lp ((i 0))
(and (< i len)
(or (apply pred? (uvector-ref vec1 i)
(map (lambda (v) (uvector-ref v i)) o))
(lp (+ i 1)))))))
(define (vector-every pred? vec1 . o)
(let ((len (apply min (uvector-length vec1)
(map uvector-length o))))
(let lp ((i 0))
(let ((x (apply pred? (uvector-ref vec1 i)
(map (lambda (v) (uvector-ref v i)) o))))
(if (= i (- len 1))
x
(and x (lp (+ i 1))))))))
(define (vector-partition pred? vec)
(let* ((len (uvector-length vec))
(res (make-uvector len)))
(let lp ((i 0) (left 0) (right (- len 1)))
(cond
((= i len)
(if (< left len)
(vector-reverse! res left))
(values res left))
(else
(let ((x (uvector-ref vec i)))
(cond
((pred? x)
(uvector-set! res left x)
(lp (+ i 1) (+ left 1) right))
(else
(uvector-set! res right x)
(lp (+ i 1) left (- right 1))))))))))
(define (vector-filter pred vec)
(list->uvector
(reverse
(vector-fold (lambda (ls elt) (if (pred elt) (cons elt ls) ls))
'() vec))))
(define (vector-remove pred vec)
(vector-filter (lambda (x) (not (pred x))) vec))
(define (reverse-vector->list vec . o)
(let ((vec (if (pair? o) (apply vector-copy vec o) vec)))
(vector-fold (lambda (ls x) (cons x ls)) '() vec)))
(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)
(list->vector (uvector->list vec)))
(define (vector->uvector vec)
(list->uvector (vector->list vec)))
(define make-vector-generator
(let ((eof (read-char (open-input-string ""))))
(lambda (vec)
(let ((i 0) (len (uvector-length vec)))
(lambda ()
(if (>= i len)
eof
(let ((res (uvector-ref vec i)))
(set! i (+ i 1))
res)))))))
(define write-vector write)

35
lib/srfi/160/uvector.sld Normal file
View file

@ -0,0 +1,35 @@
(define-library (srfi 160 uvector)
(import (scheme base) (scheme write))
(export define-uvector-procedures)
(begin
(define-syntax define-uvector-procedures
(syntax-rules ()
((define-uvector-procedures
;; primitives supplied
u? uvector? make-uvector
uvector-length uvector-ref uvector-set!
;; derived
uvector uvector-unfold uvector-unfold-right
uvector-copy uvector-reverse-copy uvector-append
uvector-concatenate uvector-append-subvectors
uvector-empty? uvector=
uvector-take uvector-take-right
uvector-drop uvector-drop-right
uvector-segment uvector-fold uvector-fold-right
uvector-map uvector-map! uvector-for-each
uvector-count uvector-cumulate
uvector-take-while uvector-take-while-right
uvector-drop-while uvector-drop-while-right
uvector-index uvector-index-right
uvector-skip uvector-skip-right
uvector-binary-search uvector-any uvector-every
uvector-partition uvector-filter uvector-remove
uvector-swap! uvector-fill!
uvector-reverse! uvector-copy! uvector-reverse-copy!
uvector->list reverse-uvector->list list->uvector
uvector->vector vector->uvector
make-uvector-generator write-uvector)
(begin
))))))

2
tests/lib-tests.scm
View file

@ -28,6 +28,7 @@
(rename (srfi 134 test) (run-tests run-srfi-134-tests)) (rename (srfi 134 test) (run-tests run-srfi-134-tests))
(rename (srfi 139 test) (run-tests run-srfi-139-tests)) (rename (srfi 139 test) (run-tests run-srfi-139-tests))
(rename (srfi 151 test) (run-tests run-srfi-151-tests)) (rename (srfi 151 test) (run-tests run-srfi-151-tests))
(rename (srfi 160 test) (run-tests run-srfi-160-tests))
(rename (chibi base64-test) (run-tests run-base64-tests)) (rename (chibi base64-test) (run-tests run-base64-tests))
(rename (chibi bytevector-test) (run-tests run-bytevector-tests)) (rename (chibi bytevector-test) (run-tests run-bytevector-tests))
(rename (chibi crypto md5-test) (run-tests run-md5-tests)) (rename (chibi crypto md5-test) (run-tests run-md5-tests))
@ -90,6 +91,7 @@
(run-srfi-134-tests) (run-srfi-134-tests)
(run-srfi-139-tests) (run-srfi-139-tests)
(run-srfi-151-tests) (run-srfi-151-tests)
(run-srfi-160-tests)
(run-base64-tests) (run-base64-tests)
(run-bytevector-tests) (run-bytevector-tests)
(run-doc-tests) (run-doc-tests)