u8vector is implemented using bytes

svn: r5921
This commit is contained in:
Eli Barzilay 2007-04-11 06:46:17 +00:00
parent cb200bbca4
commit bf8cd534cd
2 changed files with 123 additions and 102 deletions

View File

@ -992,10 +992,15 @@
(define-syntaxes (make-srfi-4 define-srfi-4-provider) (define-syntaxes (make-srfi-4 define-srfi-4-provider)
(let ([bindings '()]) (let ([bindings '()])
(values (define (define-srfi-4-provider stx)
(lambda (stx)
(syntax-case stx () (syntax-case stx ()
[(_ TAG type) (identifier? #'TAG) [(_ x) (with-syntax ([(binding ...) bindings])
#'(define-syntax x
(syntax-rules ()
[(_) (provide binding ...)])))]))
(define (make-srfi-4 stx)
(syntax-case stx ()
[(_ TAG type more ...) (identifier? #'TAG)
(let ([name (string-append (let ([name (string-append
(symbol->string (syntax-object->datum #'TAG)) (symbol->string (syntax-object->datum #'TAG))
"vector")]) "vector")])
@ -1028,6 +1033,18 @@
#'list->TAG #'list->TAG
#'_TAG #'_TAG
bindings)) bindings))
(syntax-case #'(more ...) ()
[(X? X-length make-X X X-ref X-set! X->list list->X _X)
#'(provide (rename X? TAG? )
(rename X-length TAG-length)
(rename make-X make-TAG )
(rename X TAG )
(rename X-ref TAG-ref )
(rename X-set! TAG-set! )
(rename X->list TAG->list )
(rename list->X list->TAG )
(rename _X _TAG ))]
[()
#'(begin #'(begin
(define-struct TAG (ptr length)) (define-struct TAG (ptr length))
(provide TAG? TAG-length) (provide TAG? TAG-length)
@ -1086,16 +1103,14 @@
post: (x => tmp))] post: (x => tmp))]
[(_ . xs) (_TAG* . xs)] [(_ . xs) (_TAG* . xs)]
[_ _TAG*])) [_ _TAG*]))
)))])) )])))]))
(lambda (stx) (values make-srfi-4 define-srfi-4-provider)))
(syntax-case stx ()
[(_ x) (with-syntax ([(binding ...) bindings])
#'(define-syntax x
(syntax-rules ()
[(_) (provide binding ...)])))])))))
(make-srfi-4 s8 _int8) (make-srfi-4 s8 _int8)
(make-srfi-4 u8 _uint8) ;; this one is implemented as byte strings
(make-srfi-4 u8 _uint8
bytes? bytes-length make-bytes bytes bytes-ref bytes-set!
bytes->list list->bytes _bytes)
(make-srfi-4 s16 _int16) (make-srfi-4 s16 _int16)
(make-srfi-4 u16 _uint16) (make-srfi-4 u16 _uint16)
(make-srfi-4 s32 _int32) (make-srfi-4 s32 _int32)

View File

@ -126,7 +126,13 @@
;; computes permissions that are needed for require specs (`read' for all ;; computes permissions that are needed for require specs (`read' for all
;; files and "compiled" subdirs, `exists' for the base-dir) ;; files and "compiled" subdirs, `exists' for the base-dir)
(define (module-specs->path-permissions mods) (define (module-specs->path-permissions mods)
(define _ (with-output-to-file "/dev/stderr"
(lambda () (printf ">>> mods = ~s\n" mods))
'append))
(define paths (module-specs->non-lib-paths mods)) (define paths (module-specs->non-lib-paths mods))
(define _1 (with-output-to-file "/dev/stderr"
(lambda () (printf ">>> paths = ~s\n" paths))
'append))
(define bases (define bases
(let loop ([paths paths] [bases '()]) (let loop ([paths paths] [bases '()])
(if (null? paths) (if (null? paths)