* added an (ikarus system $bytevectors) library
This commit is contained in:
parent
97f59ad1ee
commit
9d3e23fb6d
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -126,6 +126,12 @@
|
|||
[$string-length 1 value]
|
||||
[$string-ref 2 value]
|
||||
[$string-set! 3 effect]
|
||||
;;; bytevectors
|
||||
[bytevector? 1 pred]
|
||||
[$make-bytevector 1 value]
|
||||
[$bytevector-length 1 value]
|
||||
[$bytevector-ref 2 value]
|
||||
[$bytevector-set! 3 effect]
|
||||
;;; symbols
|
||||
[$make-symbol 1 value]
|
||||
[$symbol-value 1 value]
|
||||
|
|
|
@ -117,6 +117,7 @@
|
|||
[$chars (ikarus system $chars) #f]
|
||||
[$strings (ikarus system $strings) #f]
|
||||
[$vectors (ikarus system $vectors) #f]
|
||||
[$bytes (ikarus system $bytevectors) #f]
|
||||
[$fx (ikarus system $fx) #f]
|
||||
[$symbols (ikarus system $symbols) #f]
|
||||
[$records (ikarus system $records) #f]
|
||||
|
@ -130,6 +131,7 @@
|
|||
[$boot (ikarus system $bootstrap) #f]
|
||||
))
|
||||
|
||||
|
||||
(define bootstrap-collection
|
||||
(let ([ls (map
|
||||
(lambda (x)
|
||||
|
@ -469,6 +471,14 @@
|
|||
[$string-set! $strings]
|
||||
[$string-length $strings]
|
||||
|
||||
[bytevector? i]
|
||||
|
||||
[$make-bytevector $bytes]
|
||||
[$bytevector-length $bytes]
|
||||
[$bytevector-ref $bytes]
|
||||
[$bytevector-set! $bytes]
|
||||
|
||||
|
||||
[$make-vector $vectors]
|
||||
[$vector-length $vectors]
|
||||
[$vector-ref $vectors]
|
||||
|
|
|
@ -0,0 +1,7 @@
|
|||
#!/usr/bin/env ikarus --r6rs-script
|
||||
|
||||
(import (ikarus)
|
||||
(tests bytevectors))
|
||||
|
||||
(test-bytevectors)
|
||||
(printf "Happy Happy Joy Joy\n")
|
|
@ -0,0 +1,23 @@
|
|||
|
||||
(library (tests bytevectors)
|
||||
(export test-bytevectors)
|
||||
(import (ikarus) (tests framework))
|
||||
|
||||
(define (not-byte-vector? x)
|
||||
(not (bytevector? x)))
|
||||
|
||||
(define-tests test-bytevectors
|
||||
[bytevector? (make-bytevector 1)]
|
||||
[bytevector? (make-bytevector 1 17)]
|
||||
[bytevector? (make-bytevector 10 -17)]
|
||||
[not-bytevector? 'foo]
|
||||
[not-bytevector? "hey"]
|
||||
[not-bytevector? (current-output-port)]
|
||||
[not-bytevector? (current-input-port)]
|
||||
[not-bytevector? '#(2837 2398 239)]
|
||||
))
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
|
||||
(library (tests framework)
|
||||
(export define-tests)
|
||||
(import (ikarus))
|
||||
(define-syntax define-tests
|
||||
(syntax-rules ()
|
||||
[(_ test-all [p0 e0] ...)
|
||||
(define test-all
|
||||
(lambda ()
|
||||
(let ([p p0] [e e0])
|
||||
(unless (p e)
|
||||
(error 'test-all "~s failed, got ~s"
|
||||
'(p0 e0) e)))
|
||||
...
|
||||
(printf "[~s] Happy Happy Joy Joy\n" 'test-all)))])))
|
Loading…
Reference in New Issue