suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

u8vector is implemented using bytes

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/mzlib/foreign.ss
View File

@ -992,10 +992,15 @@
(define-syntaxes (make-srfi-4 define-srfi-4-provider)
(let ([bindings '()])
(values
(lambda (stx)
(define (define-srfi-4-provider 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
(symbol->string (syntax-object->datum #'TAG))
"vector")])
@ -1028,6 +1033,18 @@
#'list->TAG
#'_TAG
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
(define-struct TAG (ptr length))
(provide TAG? TAG-length)
@ -1086,16 +1103,14 @@
post: (x => tmp))]
[(_ . xs) (_TAG* . xs)]
[_ _TAG*]))
)))]))
(lambda (stx)
(syntax-case stx ()
[(_ x) (with-syntax ([(binding ...) bindings])
#'(define-syntax x
(syntax-rules ()
[(_) (provide binding ...)])))])))))
)])))]))
(values make-srfi-4 define-srfi-4-provider)))
(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 u16 _uint16)
(make-srfi-4 s32 _int32)

6
collects/mzlib/sandbox.ss
View File

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