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

Keep source location around for derived pair optimizations.

Browse Source 
original commit: 5a151420e46fd06221c63504509de9608365e411
This commit is contained in:
Vincent St-Amour 2011-05-26 14:51:05 -04:00
parent 90e30bb455
commit 9c0d671167
4 changed files with 83 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt
View File

@ -1,11 +1,15 @@
#;
(
#f (no location) car -- pair
derived-pair.rkt 17:0 (#%app caar (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3))) -- derived pair
#f (no location) cdr -- pair
derived-pair.rkt 18:0 (#%app cadr (#%app cons (quote 1) (#%app cons (quote 2) (quote 3)))) -- derived pair
derived-pair.rkt 19:0 (#%app cdar (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3))) -- derived pair
derived-pair.rkt 20:0 (#%app cddr (#%app cons (quote 1) (#%app cons (quote 2) (quote 3)))) -- derived pair
derived-pair.rkt 21:0 car -- pair
derived-pair.rkt 21:0 (#%app caar (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3))) -- derived pair
derived-pair.rkt 22:0 car -- pair
derived-pair.rkt 22:0 cdr -- pair
derived-pair.rkt 22:0 (#%app cadr (#%app cons (quote 1) (#%app cons (quote 2) (quote 3)))) -- derived pair
derived-pair.rkt 23:0 cdr -- pair
derived-pair.rkt 23:0 car -- pair
derived-pair.rkt 23:0 (#%app cdar (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3))) -- derived pair
derived-pair.rkt 24:0 cdr -- pair
derived-pair.rkt 24:0 (#%app cddr (#%app cons (quote 1) (#%app cons (quote 2) (quote 3)))) -- derived pair
1
2
2

32
collects/tests/typed-scheme/optimizer/tests/derived-pair2.rkt
View File

@ -1,15 +1,27 @@
#;
(
#f (no location) car -- pair
derived-pair2.rkt 25:0 (#%app caaar (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4))) -- derived pair
#f (no location) cdr -- pair
derived-pair2.rkt 26:0 (#%app caadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)))) -- derived pair
derived-pair2.rkt 27:0 (#%app cadar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4))) -- derived pair
derived-pair2.rkt 28:0 (#%app caddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))))) -- derived pair
derived-pair2.rkt 29:0 (#%app cdaar (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4))) -- derived pair
derived-pair2.rkt 30:0 (#%app cdadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)))) -- derived pair
derived-pair2.rkt 31:0 (#%app cddar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4))) -- derived pair
derived-pair2.rkt 32:0 (#%app cdddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))))) -- derived pair
derived-pair2.rkt 37:0 car -- pair
derived-pair2.rkt 37:0 (#%app caaar (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4))) -- derived pair
derived-pair2.rkt 38:0 car -- pair
derived-pair2.rkt 38:0 cdr -- pair
derived-pair2.rkt 38:0 (#%app caadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)))) -- derived pair
derived-pair2.rkt 39:0 car -- pair
derived-pair2.rkt 39:0 cdr -- pair
derived-pair2.rkt 39:0 (#%app cadar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4))) -- derived pair
derived-pair2.rkt 40:0 car -- pair
derived-pair2.rkt 40:0 cdr -- pair
derived-pair2.rkt 40:0 (#%app caddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))))) -- derived pair
derived-pair2.rkt 41:0 cdr -- pair
derived-pair2.rkt 41:0 car -- pair
derived-pair2.rkt 41:0 (#%app cdaar (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4))) -- derived pair
derived-pair2.rkt 42:0 cdr -- pair
derived-pair2.rkt 42:0 car -- pair
derived-pair2.rkt 42:0 (#%app cdadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)))) -- derived pair
derived-pair2.rkt 43:0 cdr -- pair
derived-pair2.rkt 43:0 car -- pair
derived-pair2.rkt 43:0 (#%app cddar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4))) -- derived pair
derived-pair2.rkt 44:0 cdr -- pair
derived-pair2.rkt 44:0 (#%app cdddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))))) -- derived pair
1
2
2

64
collects/tests/typed-scheme/optimizer/tests/derived-pair3.rkt
View File

@ -1,23 +1,51 @@
#;
(
#f (no location) car -- pair
derived-pair3.rkt 41:0 (#%app caaaar (#%app cons (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4)) (quote 5))) -- derived pair
#f (no location) cdr -- pair
derived-pair3.rkt 42:0 (#%app caaadr (#%app cons (quote 1) (#%app cons (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)) (quote 5)))) -- derived pair
derived-pair3.rkt 43:0 (#%app caadar (#%app cons (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4))) (quote 5))) -- derived pair
derived-pair3.rkt 44:0 (#%app caaddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (#%app cons (quote 3) (quote 4)) (quote 5))))) -- derived pair
derived-pair3.rkt 45:0 (#%app cadaar (#%app cons (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4)) (quote 5))) -- derived pair
derived-pair3.rkt 46:0 (#%app cadadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))) (quote 5)))) -- derived pair
derived-pair3.rkt 47:0 (#%app caddar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4)))) (quote 5))) -- derived pair
derived-pair3.rkt 48:0 (#%app cadddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (#%app cons (quote 4) (quote 5)))))) -- derived pair
derived-pair3.rkt 49:0 (#%app cdaaar (#%app cons (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4)) (quote 5))) -- derived pair
derived-pair3.rkt 50:0 (#%app cdaadr (#%app cons (quote 1) (#%app cons (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)) (quote 5)))) -- derived pair
derived-pair3.rkt 51:0 (#%app cdadar (#%app cons (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4))) (quote 5))) -- derived pair
derived-pair3.rkt 52:0 (#%app cdaddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (#%app cons (quote 3) (quote 4)) (quote 5))))) -- derived pair
derived-pair3.rkt 53:0 (#%app cddaar (#%app cons (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4)) (quote 5))) -- derived pair
derived-pair3.rkt 54:0 (#%app cddadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))) (quote 5)))) -- derived pair
derived-pair3.rkt 55:0 (#%app cdddar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4)))) (quote 5))) -- derived pair
derived-pair3.rkt 56:0 (#%app cddddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (#%app cons (quote 4) (quote 5)))))) -- derived pair
derived-pair3.rkt 69:0 car -- pair
derived-pair3.rkt 69:0 (#%app caaaar (#%app cons (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4)) (quote 5))) -- derived pair
derived-pair3.rkt 70:0 car -- pair
derived-pair3.rkt 70:0 cdr -- pair
derived-pair3.rkt 70:0 (#%app caaadr (#%app cons (quote 1) (#%app cons (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)) (quote 5)))) -- derived pair
derived-pair3.rkt 71:0 car -- pair
derived-pair3.rkt 71:0 cdr -- pair
derived-pair3.rkt 71:0 (#%app caadar (#%app cons (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4))) (quote 5))) -- derived pair
derived-pair3.rkt 72:0 car -- pair
derived-pair3.rkt 72:0 cdr -- pair
derived-pair3.rkt 72:0 (#%app caaddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (#%app cons (quote 3) (quote 4)) (quote 5))))) -- derived pair
derived-pair3.rkt 73:0 car -- pair
derived-pair3.rkt 73:0 cdr -- pair
derived-pair3.rkt 73:0 (#%app cadaar (#%app cons (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4)) (quote 5))) -- derived pair
derived-pair3.rkt 74:0 car -- pair
derived-pair3.rkt 74:0 cdr -- pair
derived-pair3.rkt 74:0 (#%app cadadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))) (quote 5)))) -- derived pair
derived-pair3.rkt 75:0 car -- pair
derived-pair3.rkt 75:0 cdr -- pair
derived-pair3.rkt 75:0 (#%app caddar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4)))) (quote 5))) -- derived pair
derived-pair3.rkt 76:0 car -- pair
derived-pair3.rkt 76:0 cdr -- pair
derived-pair3.rkt 76:0 (#%app cadddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (#%app cons (quote 4) (quote 5)))))) -- derived pair
derived-pair3.rkt 77:0 cdr -- pair
derived-pair3.rkt 77:0 car -- pair
derived-pair3.rkt 77:0 (#%app cdaaar (#%app cons (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4)) (quote 5))) -- derived pair
derived-pair3.rkt 78:0 cdr -- pair
derived-pair3.rkt 78:0 car -- pair
derived-pair3.rkt 78:0 (#%app cdaadr (#%app cons (quote 1) (#%app cons (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)) (quote 5)))) -- derived pair
derived-pair3.rkt 79:0 cdr -- pair
derived-pair3.rkt 79:0 car -- pair
derived-pair3.rkt 79:0 (#%app cdadar (#%app cons (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4))) (quote 5))) -- derived pair
derived-pair3.rkt 80:0 cdr -- pair
derived-pair3.rkt 80:0 car -- pair
derived-pair3.rkt 80:0 (#%app cdaddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (#%app cons (quote 3) (quote 4)) (quote 5))))) -- derived pair
derived-pair3.rkt 81:0 cdr -- pair
derived-pair3.rkt 81:0 car -- pair
derived-pair3.rkt 81:0 (#%app cddaar (#%app cons (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4)) (quote 5))) -- derived pair
derived-pair3.rkt 82:0 cdr -- pair
derived-pair3.rkt 82:0 car -- pair
derived-pair3.rkt 82:0 (#%app cddadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))) (quote 5)))) -- derived pair
derived-pair3.rkt 83:0 cdr -- pair
derived-pair3.rkt 83:0 car -- pair
derived-pair3.rkt 83:0 (#%app cdddar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4)))) (quote 5))) -- derived pair
derived-pair3.rkt 84:0 cdr -- pair
derived-pair3.rkt 84:0 (#%app cddddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (#%app cons (quote 4) (quote 5)))))) -- derived pair
1
2
2

6
collects/typed-scheme/optimizer/pair.rkt
View File

@ -62,6 +62,10 @@
#`(op.unsafe #,@(syntax-map (optimize) #'(p e ...))))))
;; change the source location of a given syntax object
(define (relocate stx loc-stx)
(datum->syntax stx (syntax->datum stx) loc-stx stx stx))
;; if the equivalent sequence of cars and cdrs is guaranteed not to fail,
;; we can optimize
@ -73,7 +77,7 @@
(if (null? accessors)
#'arg
(quasisyntax/loc stx
(#%plain-app #,(car accessors)
(#%plain-app #,(relocate (car accessors) stx)
#,(gen-alt-helper (cdr accessors))))))
(let ((ty (type-of stx))
(obj (gen-alt-helper accessors)))