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

Fix for escaping functions.

Browse Source 
original commit: eed20f7c3a8a459dedc8798777ff3df71f2cfb2b
This commit is contained in:
Vincent St-Amour 2010-07-28 12:39:50 -04:00
parent 0f5db893f5
commit c631cec4d8
1 changed files with 39 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
collects/typed-scheme/optimizer/unboxed-let.rkt
View File

@ -38,44 +38,45 @@
(partition
(lambda (p)
(let ((fun-name (car (syntax-e (car p)))))
(and (match (type-of (cadr p)) ; rhs, we want a lambda
[(tc-result1: (Function: (list (arr: doms rngs
(and rests #f)
(and drests #f)
(and kws '())))))
;; at least 1 argument has to be of type inexact-complex
;; and can be unboxed
(syntax-parse (cadr p)
[(#%plain-lambda params body ...)
;; keep track of the param # of each param that can be unboxed
(let loop ((unboxed '())
(boxed '())
(i 0)
(params (syntax->list #'params))
(doms doms))
(cond [(null? params)
;; done. can we unbox anything?
(and (> (length unboxed) 0)
;; if so, add to the table of functions with
;; unboxed params, so we can modify its call
;; sites, it's body and its header
(dict-set! unboxed-funs-table fun-name
(list (reverse unboxed)
(reverse boxed))))]
[(and (equal? (car doms) -InexactComplex)
(could-be-unboxed-in?
(car params) #'(begin body ...)))
;; we can unbox
(loop (cons i unboxed) boxed
(add1 i) (cdr params) (cdr doms))]
[else ; can't unbox
(loop unboxed (cons i boxed)
(add1 i) (cdr params) (cdr doms))]))]
[_ #f])]
[_ #f])
;; if the function escapes, we can't change it's interface
(and (not (is-var-mutated? fun-name))
(not (escapes? fun-name #'(begin body ...)))))))
(and
;; if the function escapes, we can't change it's interface
(and (not (is-var-mutated? fun-name))
(not (escapes? fun-name #'(begin body ...))))
(match (type-of (cadr p)) ; rhs, we want a lambda
[(tc-result1: (Function: (list (arr: doms rngs
(and rests #f)
(and drests #f)
(and kws '())))))
;; at least 1 argument has to be of type inexact-complex
;; and can be unboxed
(syntax-parse (cadr p)
[(#%plain-lambda params body ...)
;; keep track of the param # of each param that can be unboxed
(let loop ((unboxed '())
(boxed '())
(i 0)
(params (syntax->list #'params))
(doms doms))
(cond [(null? params)
;; done. can we unbox anything?
(and (> (length unboxed) 0)
;; if so, add to the table of functions with
;; unboxed params, so we can modify its call
;; sites, it's body and its header
(dict-set! unboxed-funs-table fun-name
(list (reverse unboxed)
(reverse boxed))))]
[(and (equal? (car doms) -InexactComplex)
(could-be-unboxed-in?
(car params) #'(begin body ...)))
;; we can unbox
(loop (cons i unboxed) boxed
(add1 i) (cdr params) (cdr doms))]
[else ; can't unbox
(loop unboxed (cons i boxed)
(add1 i) (cdr params) (cdr doms))]))]
[_ #f])]
[_ #f]))))
rest)))
(list candidates function-candidates others))
#:with (opt-candidates:unboxed-let-clause ...) #'(candidates ...)