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

Added optimizations for iterating over vectors and strings.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-07-12 14:39:06 -04:00
parent 1e550139aa
commit 0b0da84eba
9 changed files with 219 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/typed-scheme/optimizer/generic/in-bytes.rkt Normal file
View File

@ -0,0 +1,4 @@
#lang typed/scheme #:optimize
(require racket/unsafe/ops)
(for: ((i : Integer #"123"))
(display i))

4
collects/tests/typed-scheme/optimizer/generic/in-string.rkt Normal file
View File

@ -0,0 +1,4 @@
#lang typed/scheme #:optimize
(require racket/unsafe/ops)
(for: ((i : Char "123"))
(display i))

4
collects/tests/typed-scheme/optimizer/generic/in-vector.rkt Normal file
View File

@ -0,0 +1,4 @@
#lang typed/scheme #:optimize
(require racket/unsafe/ops)
(for: ((i : Integer (vector 1 2 3)))
(display i))

37
collects/tests/typed-scheme/optimizer/hand-optimized/in-bytes.rkt Normal file
View File

@ -0,0 +1,37 @@
#lang racket
(require racket/unsafe/ops)
;; the following code should be equivalent to the code generated by:
;; (for: ((i : Integer (in-bytes #"123")))
;; (display i))
(let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?)
(let* ((i #"123")
(len (bytes-length i)))
(values (lambda (x) (bytes-ref i x))
(lambda (x) (unsafe-fx+ 1 x))
0
(lambda (x) (unsafe-fx< x len))
(lambda (x) #t)
(lambda (x y) #t)))))
(void)
((letrec-values (((for-loop)
(#%plain-lambda
(fold-var pos)
(if (pos-cont? pos)
(let-values (((i) (pos->vals pos)))
(if (val-cont? i)
(let-values (((fold-var)
(let-values (((fold-var)
fold-var))
(let-values ()
(let-values ()
(display i))
(void)))))
(if (all-cont? pos i)
(for-loop fold-var (pos-next pos))
fold-var))
fold-var))
fold-var))))
for-loop)
(void)
init))
(void)

37
collects/tests/typed-scheme/optimizer/hand-optimized/in-string.rkt Normal file
View File

@ -0,0 +1,37 @@
#lang racket
(require racket/unsafe/ops)
;; the following code should be equivalent to the code generated by:
;; (for: ((i : Char (in-string "123")))
;; (display i))
(let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?)
(let* ((i "123")
(len (string-length i)))
(values (lambda (x) (string-ref i x))
(lambda (x) (unsafe-fx+ 1 x))
0
(lambda (x) (unsafe-fx< x len))
(lambda (x) #t)
(lambda (x y) #t)))))
(void)
((letrec-values (((for-loop)
(#%plain-lambda
(fold-var pos)
(if (pos-cont? pos)
(let-values (((i) (pos->vals pos)))
(if (val-cont? i)
(let-values (((fold-var)
(let-values (((fold-var)
fold-var))
(let-values ()
(let-values ()
(display i))
(void)))))
(if (all-cont? pos i)
(for-loop fold-var (pos-next pos))
fold-var))
fold-var))
fold-var))))
for-loop)
(void)
init))
(void)

37
collects/tests/typed-scheme/optimizer/hand-optimized/in-vector.rkt Normal file
View File

@ -0,0 +1,37 @@
#lang racket
(require racket/unsafe/ops)
;; the following code should be equivalent to the code generated by:
;; (for: ((i : Integer (in-vector '(1 2 3))))
;; (display i))
(let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?)
(let* ((i (vector 1 2 3))
(len (unsafe-vector*-length i)))
(values (lambda (x) (unsafe-vector*-ref i x))
(lambda (x) (unsafe-fx+ 1 x))
0
(lambda (x) (unsafe-fx< x len))
(lambda (x) #t)
(lambda (x y) #t)))))
(void)
((letrec-values (((for-loop)
(#%plain-lambda
(fold-var pos)
(if (pos-cont? pos)
(let-values (((i) (pos->vals pos)))
(if (val-cont? i)
(let-values (((fold-var)
(let-values (((fold-var)
fold-var))
(let-values ()
(let-values ()
(display i))
(void)))))
(if (all-cont? pos i)
(for-loop fold-var (pos-next pos))
fold-var))
fold-var))
fold-var))))
for-loop)
(void)
init))
(void)

35
collects/typed-scheme/optimizer/list.rkt
View File

@ -1,35 +0,0 @@
#lang scheme/base
(require syntax/parse
syntax/id-table racket/dict
unstable/match scheme/match
(for-template scheme/base scheme/unsafe/ops)
"../utils/utils.rkt" "../utils/tc-utils.rkt"
(rep type-rep)
(types abbrev type-table utils subtype)
(optimizer utils))
(provide list-opt-expr)
(define-syntax-class list-expr
(pattern e:expr
#:when (match (type-of #'e)
[(tc-result1: (Listof: _)) #t]
[(tc-result1: (List: _)) #t]
[_ #f])
#:with opt ((optimize) #'e)))
(define-syntax-class list-opt-expr
;; if we're iterating (with the for macros) over something we know is a list,
;; we can generate code that would be similar to if in-list had been used
(pattern (#%plain-app op:id _ l)
#:when (id-from? #'op 'make-sequence 'racket/private/for)
#:with l*:list-expr #'l
#:with opt
(begin (log-optimization "in-list" #'op)
#'(let ((i l*.opt))
(values unsafe-car unsafe-cdr i
(lambda (x) (not (null? x)))
(lambda (x) #t)
(lambda (x y) #t))))))

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

@ -5,7 +5,7 @@
(for-template scheme/base scheme/flonum scheme/fixnum scheme/unsafe/ops racket/private/for)
"../utils/utils.rkt"
(types abbrev type-table utils subtype)
(optimizer utils fixnum float inexact-complex vector pair list struct dead-code))
(optimizer utils fixnum float inexact-complex vector pair sequence struct dead-code))
(provide optimize-top)
@ -23,7 +23,7 @@
(pattern e:inexact-complex-opt-expr #:with opt #'e.opt)
(pattern e:vector-opt-expr #:with opt #'e.opt)
(pattern e:pair-opt-expr #:with opt #'e.opt)
(pattern e:list-opt-expr #:with opt #'e.opt)
(pattern e:sequence-opt-expr #:with opt #'e.opt)
(pattern e:struct-opt-expr #:with opt #'e.opt)
(pattern e:dead-code-opt-expr #:with opt #'e.opt)

94
collects/typed-scheme/optimizer/sequence.rkt Normal file
View File

@ -0,0 +1,94 @@
#lang scheme/base
(require syntax/parse
syntax/id-table racket/dict
unstable/match scheme/match
(for-template scheme/base scheme/unsafe/ops)
"../utils/utils.rkt" "../utils/tc-utils.rkt"
(rep type-rep)
(types abbrev type-table utils subtype)
(optimizer utils))
(provide sequence-opt-expr)
(define-syntax-class list-expr
(pattern e:expr
#:when (match (type-of #'e)
[(tc-result1: (Listof: _)) #t]
[(tc-result1: (List: _)) #t]
[_ #f])
#:with opt ((optimize) #'e)))
;; unlike other vector optimizations, this works on unknown-length vectors
(define-syntax-class vector-expr
(pattern e:expr
#:when (match (type-of #'e)
[(tc-result1: (Vector: _)) #t]
[(tc-result1: (HeterogenousVector: _)) #t]
[_ #f])
#:with opt ((optimize) #'e)))
(define-syntax-class string-expr
(pattern e:expr
#:when (isoftype? #'e -String)
#:with opt ((optimize) #'e)))
(define-syntax-class bytes-expr
(pattern e:expr
#:when (isoftype? #'e -Bytes)
#:with opt ((optimize) #'e)))
(define-syntax-class sequence-opt-expr
;; if we're iterating (with the for macros) over something we know is a list,
;; we can generate code that would be similar to if in-list had been used
(pattern (#%plain-app op:id _ l)
#:when (id-from? #'op 'make-sequence 'racket/private/for)
#:with l*:list-expr #'l
#:with opt
(begin (log-optimization "in-list" #'op)
#'(let ((i l*.opt))
(values unsafe-car unsafe-cdr i
(lambda (x) (not (null? x)))
(lambda (x) #t)
(lambda (x y) #t)))))
;; idem for vectors
(pattern (#%plain-app op:id _ v)
#:when (id-from? #'op 'make-sequence 'racket/private/for)
#:with v*:vector-expr #'v
#:with opt
(begin (log-optimization "in-vector" #'op)
#'(let* ((i v*.opt)
(len (unsafe-vector*-length i)))
(values (lambda (x) (unsafe-vector*-ref i x))
(lambda (x) (unsafe-fx+ 1 x))
0
(lambda (x) (unsafe-fx< x len))
(lambda (x) #t)
(lambda (x y) #t)))))
;; and (byte) strings
(pattern (#%plain-app op:id _ s)
#:when (id-from? #'op 'make-sequence 'racket/private/for)
#:with s*:string-expr #'s
#:with opt
(begin (log-optimization "in-string" #'op)
#'(let* ((i s*.opt)
(len (string-length i)))
(values (lambda (x) (string-ref i x))
(lambda (x) (unsafe-fx+ 1 x))
0
(lambda (x) (unsafe-fx< x len))
(lambda (x) #t)
(lambda (x y) #t)))))
(pattern (#%plain-app op:id _ s)
#:when (id-from? #'op 'make-sequence 'racket/private/for)
#:with s*:bytes-expr #'s
#:with opt
(begin (log-optimization "in-bytes" #'op)
#'(let* ((i s*.opt)
(len (bytes-length i)))
(values (lambda (x) (bytes-ref i x))
(lambda (x) (unsafe-fx+ 1 x))
0
(lambda (x) (unsafe-fx< x len))
(lambda (x) #t)
(lambda (x y) #t))))))