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

Cleanup struct optimizations.

Browse Source 
original commit: 9bafe3b674853788cd5d27e611b7b483ab12279b
This commit is contained in:
Eric Dobson 2013-09-04 21:57:45 -07:00
parent 58e7c1f024
commit 57cdc95b1f
1 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/struct.rkt
View File

@ -11,18 +11,24 @@
(define struct-opt-msg "Struct access specialization.")
(define-syntax-class struct-op
#:attributes (message opt idx)
(pattern op:id
#:when (struct-accessor? #'op)
#:attr message "struct ref"
#:with idx #`'#,(struct-fn-idx #'op)
#:with opt #'unsafe-struct-ref)
(pattern op:id
#:when (struct-mutator? #'op)
#:attr message "struct set"
#:with idx #`'#,(struct-fn-idx #'op)
#:with opt #'unsafe-struct-set!))
(define-syntax-class struct-opt-expr
#:commit
;; we can always optimize struct accessors and mutators
;; if they typecheck, they're safe
(pattern (#%plain-app op:id s:expr v:expr ...)
#:when (or (struct-accessor? #'op) (struct-mutator? #'op))
#:with opt
(let ([idx (struct-fn-idx #'op)])
(add-disappeared-use #'op)
(if (struct-accessor? #'op)
(begin (log-optimization "struct ref" struct-opt-msg this-syntax)
#`(unsafe-struct-ref #,((optimize) #'s) #,idx))
(begin (log-optimization "struct set" struct-opt-msg this-syntax)
#`(unsafe-struct-set! #,((optimize) #'s) #,idx
#,@(stx-map (optimize) #'(v ...))))))))
(pattern (#%plain-app op:struct-op s:opt-expr v:opt-expr ...)
#:do [(add-disappeared-use #'op)
(log-opt (attribute op.message) struct-opt-msg)]
#:with opt #'(op.opt s.opt op.idx v.opt ...)))