Use unsafe-vector* instead of unsafe-vector in a few benchmarks.

This commit is contained in:
Sam Tobin-Hochstadt 2011-09-30 16:42:04 -04:00
parent 412201796a
commit 1d9ac41772
2 changed files with 14 additions and 15 deletions

View File

@ -8,16 +8,16 @@
(filtered-in (lambda (name) (regexp-replace #rx"unsafe-" name ""))
racket/unsafe/ops))
(define-syntax-rule (**leaf? v) (fx= 1 (vector-length v)))
(define-syntax-rule (**node? v) (fx= 3 (vector-length v)))
(define-syntax-rule (**leaf? v) (fx= 1 (vector*-length v)))
(define-syntax-rule (**node? v) (fx= 3 (vector*-length v)))
(define-syntax leaf (make-rename-transformer #'vector))
(define-syntax leaf? (make-rename-transformer #'**leaf?))
(define-syntax node (make-rename-transformer #'vector))
(define-syntax node? (make-rename-transformer #'**node?))
(define-syntax-rule (leaf-val l) (vector-ref l 0))
(define-syntax-rule (node-left n) (vector-ref n 1))
(define-syntax-rule (node-right n) (vector-ref n 2))
(define-syntax-rule (leaf-val l) (vector*-ref l 0))
(define-syntax-rule (node-left n) (vector*-ref n 1))
(define-syntax-rule (node-right n) (vector*-ref n 2))
(define (make item d)
(if (fx= d 0)

View File

@ -2,24 +2,23 @@
;; The Computer Language Benchmarks Game
;; http://shootout.alioth.debian.org/
(require racket/require (for-syntax racket/base)
(filtered-in (lambda (name) (regexp-replace #rx"unsafe-" name ""))
racket/unsafe/ops))
(define translation (make-vector 128))
(for ([from (in-string "ACGTUMRWSYKVHDBN")]
[to (in-string "TGCAAKYWSRMBDHVN")])
(let ([to (char->integer to)])
(vector-set! translation (char->integer from) to)
(vector-set! translation (char->integer (char-downcase from)) to)))
(vector*-set! translation (char->integer from) to)
(vector*-set! translation (char->integer (char-downcase from)) to)))
(define I (current-input-port))
(define O (current-output-port))
(define marker (char->integer #\>))
(require racket/require (for-syntax racket/base)
(filtered-in (lambda (name) (regexp-replace #rx"unsafe-" name ""))
racket/unsafe/ops))
(define line-length 60)
(define buf-size (* 64 1024))
(define out-buf ; so there's always enough room for newlines
@ -36,15 +35,15 @@ before dumping it out.
(let loop ([chunks chunks] [col line-length])
(when (pair? chunks)
(let ([chunk (car chunks)])
(let ([start (vector-ref chunk 0)]
[end (vector-ref chunk 1)]
[in-buf (vector-ref chunk 2)])
(let ([start (vector*-ref chunk 0)]
[end (vector*-ref chunk 1)]
[in-buf (vector*-ref chunk 2)])
(let chunk-loop ([i end] [j 0] [col col])
(if (fx> i start)
(let* ([i (fx- i 1)] [b (bytes-ref in-buf i)])
(if (fx= b LF)
(chunk-loop i j col)
(let ([b (vector-ref translation b)])
(let ([b (vector*-ref translation b)])
(if (fx= 0 col)
(begin (bytes-set! out-buf j LF)
(bytes-set! out-buf (fx+ j 1) b)