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

Adding some unsafe ops to the match compiler

Browse Source
This commit is contained in:
Jay McCarthy 2010-10-04 15:43:36 -06:00
parent 61441bba8f
commit 0965af6c69
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/racket/match/compiler.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base #lang scheme/base
(require (for-template scheme/base "runtime.rkt" scheme/stxparam) (require (for-template scheme/base "runtime.rkt" scheme/stxparam racket/unsafe/ops)
syntax/boundmap syntax/boundmap
syntax/stx syntax/stx
"patterns.rkt" "patterns.rkt"
@ -60,12 +60,13 @@
#`[(pred #,x) (let ([tmps (accs #,x)] ...) body)])) #`[(pred #,x) (let ([tmps (accs #,x)] ...) body)]))
(cond (cond
[(eq? 'box k) [(eq? 'box k)
(compile-con-pat (list #'unbox) #'box? (compose list Box-p))] (compile-con-pat (list #'unsafe-unbox*) #'box? (compose list Box-p))]
[(eq? 'pair k) [(eq? 'pair k)
(compile-con-pat (list #'car #'cdr) #'pair? (compile-con-pat (list #'unsafe-car #'unsafe-cdr) #'pair?
(lambda (p) (list (Pair-a p) (Pair-d p))))] (lambda (p) (list (Pair-a p) (Pair-d p))))]
[(eq? 'mpair k) [(eq? 'mpair k)
(compile-con-pat (list #'mcar #'mcdr) #'mpair? ; XXX These should be unsafe-mcar* when mpairs have chaperones
(compile-con-pat (list #'unsafe-mcar #'unsafe-mcdr) #'mpair?
(lambda (p) (list (MPair-a p) (MPair-d p))))] (lambda (p) (list (MPair-a p) (MPair-d p))))]
[(eq? 'string k) (constant-pat #'string?)] [(eq? 'string k) (constant-pat #'string?)]
[(eq? 'number k) (constant-pat #'number?)] [(eq? 'number k) (constant-pat #'number?)]
@ -104,10 +105,10 @@
esc)] esc)]
[(n ...) ns]) [(n ...) ns])
#`[(#,arity) #`[(#,arity)
(let ([tmps (vector-ref #,x n)] ...) (let ([tmps (unsafe-vector*-ref #,x n)] ...)
body)]))))])]) body)]))))])])
#`[(vector? #,x) #`[(vector? #,x)
(case (vector-length #,x) (case (unsafe-vector*-length #,x)
clauses ... clauses ...
[else (#,esc)])])] [else (#,esc)])])]
;; it's a structure ;; it's a structure