From 0b0da84eba4fe7dcab87e4e5eed5dd213de2dc9f Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Mon, 12 Jul 2010 14:39:06 -0400 Subject: [PATCH] Added optimizations for iterating over vectors and strings. --- .../optimizer/generic/in-bytes.rkt | 4 + .../optimizer/generic/in-string.rkt | 4 + .../optimizer/generic/in-vector.rkt | 4 + .../optimizer/hand-optimized/in-bytes.rkt | 37 ++++++++ .../optimizer/hand-optimized/in-string.rkt | 37 ++++++++ .../optimizer/hand-optimized/in-vector.rkt | 37 ++++++++ collects/typed-scheme/optimizer/list.rkt | 35 ------- collects/typed-scheme/optimizer/optimizer.rkt | 4 +- collects/typed-scheme/optimizer/sequence.rkt | 94 +++++++++++++++++++ 9 files changed, 219 insertions(+), 37 deletions(-) create mode 100644 collects/tests/typed-scheme/optimizer/generic/in-bytes.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/in-string.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/in-vector.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/in-bytes.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/in-string.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/in-vector.rkt delete mode 100644 collects/typed-scheme/optimizer/list.rkt create mode 100644 collects/typed-scheme/optimizer/sequence.rkt diff --git a/collects/tests/typed-scheme/optimizer/generic/in-bytes.rkt b/collects/tests/typed-scheme/optimizer/generic/in-bytes.rkt new file mode 100644 index 0000000000..4abbe2949a --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/in-bytes.rkt @@ -0,0 +1,4 @@ +#lang typed/scheme #:optimize +(require racket/unsafe/ops) +(for: ((i : Integer #"123")) + (display i)) diff --git a/collects/tests/typed-scheme/optimizer/generic/in-string.rkt b/collects/tests/typed-scheme/optimizer/generic/in-string.rkt new file mode 100644 index 0000000000..5a17acc3b6 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/in-string.rkt @@ -0,0 +1,4 @@ +#lang typed/scheme #:optimize +(require racket/unsafe/ops) +(for: ((i : Char "123")) + (display i)) diff --git a/collects/tests/typed-scheme/optimizer/generic/in-vector.rkt b/collects/tests/typed-scheme/optimizer/generic/in-vector.rkt new file mode 100644 index 0000000000..6cddafcf32 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/in-vector.rkt @@ -0,0 +1,4 @@ +#lang typed/scheme #:optimize +(require racket/unsafe/ops) +(for: ((i : Integer (vector 1 2 3))) + (display i)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/in-bytes.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/in-bytes.rkt new file mode 100644 index 0000000000..49cf42c33d --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/in-bytes.rkt @@ -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) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/in-string.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/in-string.rkt new file mode 100644 index 0000000000..3c68cac9b4 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/in-string.rkt @@ -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) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/in-vector.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/in-vector.rkt new file mode 100644 index 0000000000..419f6c95ee --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/in-vector.rkt @@ -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) diff --git a/collects/typed-scheme/optimizer/list.rkt b/collects/typed-scheme/optimizer/list.rkt deleted file mode 100644 index 272a21edd7..0000000000 --- a/collects/typed-scheme/optimizer/list.rkt +++ /dev/null @@ -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)))))) diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt index 6616ea6d0d..730d6680fe 100644 --- a/collects/typed-scheme/optimizer/optimizer.rkt +++ b/collects/typed-scheme/optimizer/optimizer.rkt @@ -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) diff --git a/collects/typed-scheme/optimizer/sequence.rkt b/collects/typed-scheme/optimizer/sequence.rkt new file mode 100644 index 0000000000..c17130998c --- /dev/null +++ b/collects/typed-scheme/optimizer/sequence.rkt @@ -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))))))