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

Added optimization when iterating over lists.

Browse Source 
original commit: 458b6b65c9c281c0da2f2c63de068037d3d55703
This commit is contained in:
Vincent St-Amour 2010-06-29 15:45:47 -04:00
parent f121650526
commit d1687b5b2b
4 changed files with 37 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -0,0 +1,4 @@
(module in-list typed/scheme #:optimize
(require racket/unsafe/ops)
(for: ((i : Natural '(1 2 3)))
(display i)))

26
collects/typed-scheme/private/for-clauses.rkt
View File

@ -10,21 +10,15 @@
(define-splicing-syntax-class for-clause
;; single-valued seq-expr
(pattern (~and c (var:annotated-name seq-expr:expr))
#:with (expand ...) (list (quasisyntax/loc
#:with (expand ...) (list (syntax/loc
#'c
(var.ann-name
#,(syntax-property #'seq-expr
'type-ascription
#'(Sequenceof var.ty))))))
(var.ann-name seq-expr))))
;; multi-valued seq-expr
;; currently disabled because it triggers an internal error in the typechecker
#;(pattern (~and c (((v:annotated-name) ...) seq-expr:expr))
#:with (expand ...) (list (quasisyntax/loc
#:with (expand ...) (list (syntax/loc
#'c
((v.ann-name ...)
#,(syntax-property #'seq-expr
'type-ascription
#'(Sequenceof (values v.ty ...)))))))
((v.ann-name ...) seq-expr))))
;; when clause
(pattern (~seq #:when guard:expr)
#:with (expand ...) (list #'#:when #'guard)))
@ -33,22 +27,16 @@
(define-splicing-syntax-class for*-clause
;; single-valued seq-expr
(pattern (~and c (var:annotated-name seq-expr:expr))
#:with (expand ...) (list (quasisyntax/loc
#:with (expand ...) (list (syntax/loc
#'c
(var.ann-name
#,(syntax-property #'seq-expr
'type-ascription
#'(Sequenceof var.ty))))
(var.ann-name seq-expr))
#'#:when #'#t))
;; multi-valued seq-expr
;; currently disabled because it triggers an internal error in the typechecker
#;(pattern (~and c (((v:annotated-name) ...) seq-expr:expr))
#:with (expand ...) (list (quasisyntax/loc
#'c
((v.ann-name ...)
#,(syntax-property #'seq-expr
'type-ascription
#'(Sequenceof (values v.ty ...)))))
((v.ann-name ...) seq-expr))
#'#:when #'#t))
;; when clause
(pattern (~seq #:when guard:expr)

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

@ -1,7 +1,7 @@
#lang scheme/base
(require syntax/parse (for-template scheme/base scheme/flonum scheme/fixnum scheme/unsafe/ops)
"../utils/utils.rkt" unstable/match scheme/match unstable/syntax
(require syntax/parse (for-template scheme/base scheme/flonum scheme/fixnum scheme/unsafe/ops racket/private/for)
"../utils/utils.rkt" "../utils/tc-utils.rkt" unstable/match scheme/match unstable/syntax
(rep type-rep) syntax/id-table racket/dict
(types abbrev type-table utils subtype))
(provide optimize)
@ -124,6 +124,15 @@
(pattern (~literal vector-ref) #:with unsafe #'unsafe-vector*-ref)
(pattern (~literal vector-set!) #:with unsafe #'unsafe-vector*-set!))
(define-syntax-class list-opt-expr
(pattern e:opt-expr
#:when (match (type-of #'e)
[(tc-result1: (Listof: _)) #t]
[(tc-result1: (List: _)) #t]
[_ #f])
#:with opt #'e.opt))
(define-syntax-class opt-expr
(pattern e:opt-expr*
#:with opt (syntax-recertify #'e.opt this-syntax (current-code-inspector) #f)))
@ -227,6 +236,19 @@
(begin (log-optimization "vector" #'op)
#'(op.unsafe v.opt i.opt new.opt ...)))
;; 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-opt-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)))))
;; boring cases, just recur down
(pattern (#%plain-lambda formals e:opt-expr ...)
#:with opt #'(#%plain-lambda formals e.opt ...))

10
collects/typed-scheme/private/prims.rkt
View File

@ -428,17 +428,11 @@ This file defines two sorts of primitives. All of them are provided into any mod
;; unlike the definitions in for-clauses.rkt, this does not include
;; #:when clauses, which are handled separately here
(pattern (var:annotated-name seq-expr:expr)
#:with expand #`(var.ann-name
#,(syntax-property #'seq-expr
'type-ascription
#'(Sequenceof var.ty))))
#:with expand #'(var.ann-name seq-expr))
;; multi-valued seq-expr
;; currently disabled because it triggers an internal error in the typechecker
#;(pattern ((v:annotated-name ...) seq-expr:expr)
#:with expand #`((v.ann-name ...)
#,(syntax-property #'seq-expr
'type-ascription
#'(Sequenceof (values v.ty ...))))))
#:with expand #'((v.ann-name ...) seq-expr)))
(syntax-parse clauses
[(head:for-clause next:for-clause ... #:when rest ...)
(syntax-property