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

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

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

10
collects/tests/racket/benchmarks/shootout/binarytrees-places.rkt
View File

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

19
collects/tests/racket/benchmarks/shootout/reversecomplement.rkt
View File

@ -2,24 +2,23 @@
;; The Computer Language Benchmarks Game ;; The Computer Language Benchmarks Game
;; http://shootout.alioth.debian.org/ ;; 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)) (define translation (make-vector 128))
(for ([from (in-string "ACGTUMRWSYKVHDBN")] (for ([from (in-string "ACGTUMRWSYKVHDBN")]
[to (in-string "TGCAAKYWSRMBDHVN")]) [to (in-string "TGCAAKYWSRMBDHVN")])
(let ([to (char->integer to)]) (let ([to (char->integer to)])
(vector-set! translation (char->integer from) to) (vector*-set! translation (char->integer from) to)
(vector-set! translation (char->integer (char-downcase from)) to))) (vector*-set! translation (char->integer (char-downcase from)) to)))
(define I (current-input-port)) (define I (current-input-port))
(define O (current-output-port)) (define O (current-output-port))
(define marker (char->integer #\>)) (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 line-length 60)
(define buf-size (* 64 1024)) (define buf-size (* 64 1024))
(define out-buf ; so there's always enough room for newlines (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]) (let loop ([chunks chunks] [col line-length])
(when (pair? chunks) (when (pair? chunks)
(let ([chunk (car chunks)]) (let ([chunk (car chunks)])
(let ([start (vector-ref chunk 0)] (let ([start (vector*-ref chunk 0)]
[end (vector-ref chunk 1)] [end (vector*-ref chunk 1)]
[in-buf (vector-ref chunk 2)]) [in-buf (vector*-ref chunk 2)])
(let chunk-loop ([i end] [j 0] [col col]) (let chunk-loop ([i end] [j 0] [col col])
(if (fx> i start) (if (fx> i start)
(let* ([i (fx- i 1)] [b (bytes-ref in-buf i)]) (let* ([i (fx- i 1)] [b (bytes-ref in-buf i)])
(if (fx= b LF) (if (fx= b LF)
(chunk-loop i j col) (chunk-loop i j col)
(let ([b (vector-ref translation b)]) (let ([b (vector*-ref translation b)])
(if (fx= 0 col) (if (fx= 0 col)
(begin (bytes-set! out-buf j LF) (begin (bytes-set! out-buf j LF)
(bytes-set! out-buf (fx+ j 1) b) (bytes-set! out-buf (fx+ j 1) b)