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

Added struct optimizations.

Browse Source 
original commit: a6d11a1df08336183e1af36b787c134e1bf4f469
This commit is contained in:
Vincent St-Amour 2010-07-02 18:29:14 -04:00
parent 474741601b
commit fe84eaf722
3 changed files with 25 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/tests/typed-scheme/optimizer/generic/structs.rkt Normal file
View File

@ -0,0 +1,6 @@
(module structs typed/scheme #:optimize
(require racket/unsafe/ops)
(define-struct: pt ((x : Integer) (y : Integer)) #:mutable)
(define a (pt 3 4))
(pt-x a)
(set-pt-y! a 5))

12
collects/typed-scheme/private/optimize.rkt
View File

@ -249,6 +249,18 @@
(lambda (x) #t)
(lambda (x y) #t)))))
;; we can always optimize struct accessors and mutators
;; if they typecheck, they're safe
(pattern (#%plain-app op:id s:opt-expr v:opt-expr ...)
#:when (or (struct-accessor? #'op) (struct-mutator? #'op))
#:with opt
(let ([idx (struct-fn-idx #'op)])
(if (struct-accessor? #'op)
(begin (log-optimization "struct ref" #'op)
#`(unsafe-struct-ref s.opt #,idx))
(begin (log-optimization "struct set" #'op)
#`(unsafe-struct-set! s.opt #,idx v.opt ...)))))
;; boring cases, just recur down
(pattern (#%plain-lambda formals e:opt-expr ...)
#:with opt #'(#%plain-lambda formals e.opt ...))

8
collects/typed-scheme/types/type-table.rkt
View File

@ -22,10 +22,15 @@
(let ()
(define ((mk mut?) id)
(cond [(dict-ref struct-fn-table id #f)
=> (match-lambda [(list pe #f) pe] [_ #f])]
=> (match-lambda [(list pe m) (and (eq? m mut?) pe)] [_ #f])]
[else #f]))
(values (mk #f) (mk #t))))
(define (struct-fn-idx id)
(match (dict-ref struct-fn-table id #f)
[(list (StructPE: _ idx) _) idx]
[_ (int-err (format "no struct fn table entry for ~a" (syntax->datum id)))]))
(define (make-struct-table-code)
(parameterize ([current-print-convert-hook converter]
[show-sharing #f])
@ -43,4 +48,5 @@
[add-struct-fn! (identifier? StructPE? boolean? . -> . any/c)]
[struct-accessor? (identifier? . -> . (or/c #f StructPE?))]
[struct-mutator? (identifier? . -> . (or/c #f StructPE?))]
[struct-fn-idx (identifier? . -> . exact-integer?)]
[make-struct-table-code (-> syntax?)])