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
(require (for-template scheme/base "runtime.rkt" scheme/stxparam)
(require (for-template scheme/base "runtime.rkt" scheme/stxparam racket/unsafe/ops)
syntax/boundmap
syntax/stx
"patterns.rkt"
@ -60,12 +60,13 @@
#`[(pred #,x) (let ([tmps (accs #,x)] ...) body)]))
(cond
[(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)
(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))))]
[(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))))]
[(eq? 'string k) (constant-pat #'string?)]
[(eq? 'number k) (constant-pat #'number?)]
@ -104,10 +105,10 @@
esc)]
[(n ...) ns])
#`[(#,arity)
(let ([tmps (vector-ref #,x n)] ...)
(let ([tmps (unsafe-vector*-ref #,x n)] ...)
body)]))))])])
#`[(vector? #,x)
(case (vector-length #,x)
(case (unsafe-vector*-length #,x)
clauses ...
[else (#,esc)])])]
;; it's a structure