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

Add list optimizations.

Browse Source 
original commit: 59a85b3eb2eb1f8db7200b5f3e79575ec6927362
This commit is contained in:
Vincent St-Amour 2011-07-11 15:55:07 -04:00
parent 4c281da82a
commit 124cf9c5df
4 changed files with 108 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
collects/tests/typed-scheme/optimizer/tests/known-length-lists.rkt Normal file
View File

@ -0,0 +1,51 @@
#;
(
TR opt: known-length-lists.rkt 39:1 length -- known-length list length
TR opt: known-length-lists.rkt 40:1 list-ref -- known-length list op
TR opt: known-length-lists.rkt 41:1 list-ref -- known-length list op
TR opt: known-length-lists.rkt 42:1 list-ref -- known-length list op
TR opt: known-length-lists.rkt 43:1 list-tail -- known-length list op
TR opt: known-length-lists.rkt 44:1 list-tail -- known-length list op
TR opt: known-length-lists.rkt 45:1 list-tail -- known-length list op
TR opt: known-length-lists.rkt 46:1 list-ref -- known-length list op
TR opt: known-length-lists.rkt 47:1 list-ref -- known-length list op
TR opt: known-length-lists.rkt 48:1 list-ref -- known-length list op
TR opt: known-length-lists.rkt 49:1 list-tail -- known-length list op
TR opt: known-length-lists.rkt 50:1 list-tail -- known-length list op
TR opt: known-length-lists.rkt 51:1 list-tail -- known-length list op
'(1 2 3)
3
1
2
3
'(1 2 3)
'(2 3)
'(3)
1
2
3
'(1 2 3)
'(2 3)
'(3)
)
#lang typed/racket
(define i 0)
(define j 1)
(define: k : 2 2) ; otherwise will typecheck as Positive-Byte
(define l (ann '(1 2 3) (List Byte Byte Byte)))
(length l)
(list-ref l i)
(list-ref l j)
(list-ref l k)
(list-tail l i)
(list-tail l j)
(list-tail l k)
(list-ref l 0)
(list-ref l 1)
(list-ref l 2)
(list-tail l 0)
(list-tail l 1)
(list-tail l 2)

5
collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt
View File

@ -1,7 +1,8 @@
#;
(
TR opt: unary-fixnum-nested.rkt 11:1 bitwise-not -- unary fixnum
TR opt: unary-fixnum-nested.rkt 11:14 bitwise-not -- unary fixnum
TR opt: unary-fixnum-nested.rkt 12:1 bitwise-not -- unary fixnum
TR opt: unary-fixnum-nested.rkt 12:14 bitwise-not -- unary fixnum
TR opt: unary-fixnum-nested.rkt 12:27 length -- known-length list length
3
)

52
collects/typed-scheme/optimizer/list.rkt Normal file
View File

@ -0,0 +1,52 @@
#lang racket/base
(require syntax/parse racket/match
"../utils/utils.rkt"
(rep type-rep)
(types abbrev utils type-table)
(optimizer utils logging)
(for-template racket/base racket/unsafe/ops))
(provide list-opt-expr)
(define-syntax-class known-length-list-expr
#:commit
(pattern e:expr
#:when (match (type-of #'e)
[(tc-result1: (List: es)) #t]
[_ #f])
#:with opt ((optimize) #'e)))
(define-syntax-class list-op
#:commit
(pattern (~literal list-ref) #:with unsafe #'unsafe-list-ref)
(pattern (~literal list-tail) #:with unsafe #'unsafe-list-tail))
(define-syntax-class list-opt-expr
#:commit
;; Similar to known-length vectors opts.
;; If we use `list-ref' or `list-tail' on a known-length list with a
;; literal index, we can optimize if the index is within bounds.
(pattern (#%plain-app op:list-op l:known-length-list-expr i:expr)
#:when (let ((len (match (type-of #'l)
[(tc-result1: (List: es)) (length es)]
[_ 0])) ; can't happen
(ival (or (syntax-parse #'i
[((~literal quote) i:number)
(syntax-e #'i)]
[_ #f])
(match (type-of #'i)
[(tc-result1: (Value: (? fixnum? i))) i]
[_ -1])))) ; sure to fail the next check
(<= 0 ival (sub1 len)))
#:with opt
(begin (log-optimization "known-length list op" #'op)
#`(op.unsafe l.opt #,((optimize) #'i))))
;; We know the length of known-length lists statically.
(pattern (#%plain-app (~and op (~literal length)) l:known-length-list-expr)
#:with opt
(begin (log-optimization "known-length list length" #'op)
(match (type-of #'l)
[(tc-result1: (List: es))
#`(begin l.opt #,(length es))]))))

3
collects/typed-scheme/optimizer/optimizer.rkt
View File

@ -5,7 +5,7 @@
(for-template scheme/base)
"../utils/utils.rkt"
(optimizer utils logging
number fixnum float float-complex vector string pair
number fixnum float float-complex vector string list pair
sequence box struct dead-code apply unboxed-let))
(provide optimize-top)
@ -30,6 +30,7 @@
(pattern e:float-complex-opt-expr #:with opt #'e.opt)
(pattern e:vector-opt-expr #:with opt #'e.opt)
(pattern e:string-opt-expr #:with opt #'e.opt)
(pattern e:list-opt-expr #:with opt #'e.opt)
(pattern e:pair-opt-expr #:with opt #'e.opt)
(pattern e:sequence-opt-expr #:with opt #'e.opt)
(pattern e:box-opt-expr #:with opt #'e.opt)