From a76bd4d52ddd9fe5f57002b04028d6312cfa4ab6 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 28 Mar 2012 17:27:17 -0400 Subject: [PATCH] Fix optimization of first, rest, etc. original commit: 054f4d9b563ab40c22523e6b115e1a35822b3d3d --- .../optimizer/tests/derived-pair.rkt | 8 ++--- .../optimizer/tests/derived-pair2.rkt | 16 +++++----- .../optimizer/tests/derived-pair3.rkt | 32 +++++++++---------- .../typed-racket/optimizer/tests/list.rkt | 32 +++++++++++++++++++ collects/typed-racket/optimizer/pair.rkt | 8 ++--- 5 files changed, 64 insertions(+), 32 deletions(-) create mode 100644 collects/tests/typed-racket/optimizer/tests/list.rkt diff --git a/collects/tests/typed-racket/optimizer/tests/derived-pair.rkt b/collects/tests/typed-racket/optimizer/tests/derived-pair.rkt index afc342ca..ea866049 100644 --- a/collects/tests/typed-racket/optimizer/tests/derived-pair.rkt +++ b/collects/tests/typed-racket/optimizer/tests/derived-pair.rkt @@ -2,16 +2,16 @@ ( TR opt: derived-pair.rkt 23:0 (caar (cons (cons 1 2) 3)) -- pair TR opt: derived-pair.rkt 23:0 (caar (cons (cons 1 2) 3)) -- pair -TR opt: derived-pair.rkt 23:0 (caar (cons (cons 1 2) 3)) -- derived pair + TR opt: derived-pair.rkt 24:0 (cadr (cons 1 (cons 2 3))) -- pair TR opt: derived-pair.rkt 24:0 (cadr (cons 1 (cons 2 3))) -- pair -TR opt: derived-pair.rkt 24:0 (cadr (cons 1 (cons 2 3))) -- derived pair + TR opt: derived-pair.rkt 25:0 (cdar (cons (cons 1 2) 3)) -- pair TR opt: derived-pair.rkt 25:0 (cdar (cons (cons 1 2) 3)) -- pair -TR opt: derived-pair.rkt 25:0 (cdar (cons (cons 1 2) 3)) -- derived pair + TR opt: derived-pair.rkt 26:0 (cddr (cons 1 (cons 2 3))) -- pair TR opt: derived-pair.rkt 26:0 (cddr (cons 1 (cons 2 3))) -- pair -TR opt: derived-pair.rkt 26:0 (cddr (cons 1 (cons 2 3))) -- derived pair + 1 2 2 diff --git a/collects/tests/typed-racket/optimizer/tests/derived-pair2.rkt b/collects/tests/typed-racket/optimizer/tests/derived-pair2.rkt index 91125bd2..62e1419c 100644 --- a/collects/tests/typed-racket/optimizer/tests/derived-pair2.rkt +++ b/collects/tests/typed-racket/optimizer/tests/derived-pair2.rkt @@ -3,35 +3,35 @@ TR opt: derived-pair2.rkt 47:0 (caaar (cons (cons (cons 1 2) 3) 4)) -- pair TR opt: derived-pair2.rkt 47:0 (caaar (cons (cons (cons 1 2) 3) 4)) -- pair TR opt: derived-pair2.rkt 47:0 (caaar (cons (cons (cons 1 2) 3) 4)) -- pair -TR opt: derived-pair2.rkt 47:0 (caaar (cons (cons (cons 1 2) 3) 4)) -- derived pair + TR opt: derived-pair2.rkt 48:0 (caadr (cons 1 (cons (cons 2 3) 4))) -- pair TR opt: derived-pair2.rkt 48:0 (caadr (cons 1 (cons (cons 2 3) 4))) -- pair TR opt: derived-pair2.rkt 48:0 (caadr (cons 1 (cons (cons 2 3) 4))) -- pair -TR opt: derived-pair2.rkt 48:0 (caadr (cons 1 (cons (cons 2 3) 4))) -- derived pair + TR opt: derived-pair2.rkt 49:0 (cadar (cons (cons 1 (cons 2 3)) 4)) -- pair TR opt: derived-pair2.rkt 49:0 (cadar (cons (cons 1 (cons 2 3)) 4)) -- pair TR opt: derived-pair2.rkt 49:0 (cadar (cons (cons 1 (cons 2 3)) 4)) -- pair -TR opt: derived-pair2.rkt 49:0 (cadar (cons (cons 1 (cons 2 3)) 4)) -- derived pair + TR opt: derived-pair2.rkt 50:0 (caddr (cons 1 (cons 2 (cons 3 4)))) -- pair TR opt: derived-pair2.rkt 50:0 (caddr (cons 1 (cons 2 (cons 3 4)))) -- pair TR opt: derived-pair2.rkt 50:0 (caddr (cons 1 (cons 2 (cons 3 4)))) -- pair -TR opt: derived-pair2.rkt 50:0 (caddr (cons 1 (cons 2 (cons 3 4)))) -- derived pair + TR opt: derived-pair2.rkt 51:0 (cdaar (cons (cons (cons 1 2) 3) 4)) -- pair TR opt: derived-pair2.rkt 51:0 (cdaar (cons (cons (cons 1 2) 3) 4)) -- pair TR opt: derived-pair2.rkt 51:0 (cdaar (cons (cons (cons 1 2) 3) 4)) -- pair -TR opt: derived-pair2.rkt 51:0 (cdaar (cons (cons (cons 1 2) 3) 4)) -- derived pair + TR opt: derived-pair2.rkt 52:0 (cdadr (cons 1 (cons (cons 2 3) 4))) -- pair TR opt: derived-pair2.rkt 52:0 (cdadr (cons 1 (cons (cons 2 3) 4))) -- pair TR opt: derived-pair2.rkt 52:0 (cdadr (cons 1 (cons (cons 2 3) 4))) -- pair -TR opt: derived-pair2.rkt 52:0 (cdadr (cons 1 (cons (cons 2 3) 4))) -- derived pair + TR opt: derived-pair2.rkt 53:0 (cddar (cons (cons 1 (cons 2 3)) 4)) -- pair TR opt: derived-pair2.rkt 53:0 (cddar (cons (cons 1 (cons 2 3)) 4)) -- pair TR opt: derived-pair2.rkt 53:0 (cddar (cons (cons 1 (cons 2 3)) 4)) -- pair -TR opt: derived-pair2.rkt 53:0 (cddar (cons (cons 1 (cons 2 3)) 4)) -- derived pair + TR opt: derived-pair2.rkt 54:0 (cdddr (cons 1 (cons 2 (cons 3 4)))) -- pair TR opt: derived-pair2.rkt 54:0 (cdddr (cons 1 (cons 2 (cons 3 4)))) -- pair TR opt: derived-pair2.rkt 54:0 (cdddr (cons 1 (cons 2 (cons 3 4)))) -- pair -TR opt: derived-pair2.rkt 54:0 (cdddr (cons 1 (cons 2 (cons 3 4)))) -- derived pair + 1 2 2 diff --git a/collects/tests/typed-racket/optimizer/tests/derived-pair3.rkt b/collects/tests/typed-racket/optimizer/tests/derived-pair3.rkt index e928f5fc..ebe02ad3 100644 --- a/collects/tests/typed-racket/optimizer/tests/derived-pair3.rkt +++ b/collects/tests/typed-racket/optimizer/tests/derived-pair3.rkt @@ -4,82 +4,82 @@ TR opt: derived-pair3.rkt 103:0 (caaaar (cons (cons (cons (cons 1 2) 3) 4) 5)) - TR opt: derived-pair3.rkt 103:0 (caaaar (cons (cons (cons (cons 1 2) 3) 4) 5)) -- pair TR opt: derived-pair3.rkt 103:0 (caaaar (cons (cons (cons (cons 1 2) 3) 4) 5)) -- pair TR opt: derived-pair3.rkt 103:0 (caaaar (cons (cons (cons (cons 1 2) 3) 4) 5)) -- pair -TR opt: derived-pair3.rkt 103:0 (caaaar (cons (cons (cons (cons 1 2) 3) 4) 5)) -- derived pair + TR opt: derived-pair3.rkt 104:0 (caaadr (cons 1 (cons (cons (cons 2 3) 4) 5))) -- pair TR opt: derived-pair3.rkt 104:0 (caaadr (cons 1 (cons (cons (cons 2 3) 4) 5))) -- pair TR opt: derived-pair3.rkt 104:0 (caaadr (cons 1 (cons (cons (cons 2 3) 4) 5))) -- pair TR opt: derived-pair3.rkt 104:0 (caaadr (cons 1 (cons (cons (cons 2 3) 4) 5))) -- pair -TR opt: derived-pair3.rkt 104:0 (caaadr (cons 1 (cons (cons (cons 2 3) 4) 5))) -- derived pair + TR opt: derived-pair3.rkt 105:0 (caadar (cons (cons 1 (cons (cons 2 3) 4)) 5)) -- pair TR opt: derived-pair3.rkt 105:0 (caadar (cons (cons 1 (cons (cons 2 3) 4)) 5)) -- pair TR opt: derived-pair3.rkt 105:0 (caadar (cons (cons 1 (cons (cons 2 3) 4)) 5)) -- pair TR opt: derived-pair3.rkt 105:0 (caadar (cons (cons 1 (cons (cons 2 3) 4)) 5)) -- pair -TR opt: derived-pair3.rkt 105:0 (caadar (cons (cons 1 (cons (cons 2 3) 4)) 5)) -- derived pair + TR opt: derived-pair3.rkt 106:0 (caaddr (cons 1 (cons 2 (cons (cons 3 4) 5)))) -- pair TR opt: derived-pair3.rkt 106:0 (caaddr (cons 1 (cons 2 (cons (cons 3 4) 5)))) -- pair TR opt: derived-pair3.rkt 106:0 (caaddr (cons 1 (cons 2 (cons (cons 3 4) 5)))) -- pair TR opt: derived-pair3.rkt 106:0 (caaddr (cons 1 (cons 2 (cons (cons 3 4) 5)))) -- pair -TR opt: derived-pair3.rkt 106:0 (caaddr (cons 1 (cons 2 (cons (cons 3 4) 5)))) -- derived pair + TR opt: derived-pair3.rkt 107:0 (cadaar (cons (cons (cons 1 (cons 2 3)) 4) 5)) -- pair TR opt: derived-pair3.rkt 107:0 (cadaar (cons (cons (cons 1 (cons 2 3)) 4) 5)) -- pair TR opt: derived-pair3.rkt 107:0 (cadaar (cons (cons (cons 1 (cons 2 3)) 4) 5)) -- pair TR opt: derived-pair3.rkt 107:0 (cadaar (cons (cons (cons 1 (cons 2 3)) 4) 5)) -- pair -TR opt: derived-pair3.rkt 107:0 (cadaar (cons (cons (cons 1 (cons 2 3)) 4) 5)) -- derived pair + TR opt: derived-pair3.rkt 108:0 (cadadr (cons 1 (cons (cons 2 (cons 3 4)) 5))) -- pair TR opt: derived-pair3.rkt 108:0 (cadadr (cons 1 (cons (cons 2 (cons 3 4)) 5))) -- pair TR opt: derived-pair3.rkt 108:0 (cadadr (cons 1 (cons (cons 2 (cons 3 4)) 5))) -- pair TR opt: derived-pair3.rkt 108:0 (cadadr (cons 1 (cons (cons 2 (cons 3 4)) 5))) -- pair -TR opt: derived-pair3.rkt 108:0 (cadadr (cons 1 (cons (cons 2 (cons 3 4)) 5))) -- derived pair + TR opt: derived-pair3.rkt 109:0 (caddar (cons (cons 1 (cons 2 (cons 3 4))) 5)) -- pair TR opt: derived-pair3.rkt 109:0 (caddar (cons (cons 1 (cons 2 (cons 3 4))) 5)) -- pair TR opt: derived-pair3.rkt 109:0 (caddar (cons (cons 1 (cons 2 (cons 3 4))) 5)) -- pair TR opt: derived-pair3.rkt 109:0 (caddar (cons (cons 1 (cons 2 (cons 3 4))) 5)) -- pair -TR opt: derived-pair3.rkt 109:0 (caddar (cons (cons 1 (cons 2 (cons 3 4))) 5)) -- derived pair + TR opt: derived-pair3.rkt 110:0 (cadddr (cons 1 (cons 2 (cons 3 (cons 4 5))))) -- pair TR opt: derived-pair3.rkt 110:0 (cadddr (cons 1 (cons 2 (cons 3 (cons 4 5))))) -- pair TR opt: derived-pair3.rkt 110:0 (cadddr (cons 1 (cons 2 (cons 3 (cons 4 5))))) -- pair TR opt: derived-pair3.rkt 110:0 (cadddr (cons 1 (cons 2 (cons 3 (cons 4 5))))) -- pair -TR opt: derived-pair3.rkt 110:0 (cadddr (cons 1 (cons 2 (cons 3 (cons 4 5))))) -- derived pair + TR opt: derived-pair3.rkt 111:0 (cdaaar (cons (cons (cons (cons 1 2) 3) 4) 5)) -- pair TR opt: derived-pair3.rkt 111:0 (cdaaar (cons (cons (cons (cons 1 2) 3) 4) 5)) -- pair TR opt: derived-pair3.rkt 111:0 (cdaaar (cons (cons (cons (cons 1 2) 3) 4) 5)) -- pair TR opt: derived-pair3.rkt 111:0 (cdaaar (cons (cons (cons (cons 1 2) 3) 4) 5)) -- pair -TR opt: derived-pair3.rkt 111:0 (cdaaar (cons (cons (cons (cons 1 2) 3) 4) 5)) -- derived pair + TR opt: derived-pair3.rkt 112:0 (cdaadr (cons 1 (cons (cons (cons 2 3) 4) 5))) -- pair TR opt: derived-pair3.rkt 112:0 (cdaadr (cons 1 (cons (cons (cons 2 3) 4) 5))) -- pair TR opt: derived-pair3.rkt 112:0 (cdaadr (cons 1 (cons (cons (cons 2 3) 4) 5))) -- pair TR opt: derived-pair3.rkt 112:0 (cdaadr (cons 1 (cons (cons (cons 2 3) 4) 5))) -- pair -TR opt: derived-pair3.rkt 112:0 (cdaadr (cons 1 (cons (cons (cons 2 3) 4) 5))) -- derived pair + TR opt: derived-pair3.rkt 113:0 (cdadar (cons (cons 1 (cons (cons 2 3) 4)) 5)) -- pair TR opt: derived-pair3.rkt 113:0 (cdadar (cons (cons 1 (cons (cons 2 3) 4)) 5)) -- pair TR opt: derived-pair3.rkt 113:0 (cdadar (cons (cons 1 (cons (cons 2 3) 4)) 5)) -- pair TR opt: derived-pair3.rkt 113:0 (cdadar (cons (cons 1 (cons (cons 2 3) 4)) 5)) -- pair -TR opt: derived-pair3.rkt 113:0 (cdadar (cons (cons 1 (cons (cons 2 3) 4)) 5)) -- derived pair + TR opt: derived-pair3.rkt 114:0 (cdaddr (cons 1 (cons 2 (cons (cons 3 4) 5)))) -- pair TR opt: derived-pair3.rkt 114:0 (cdaddr (cons 1 (cons 2 (cons (cons 3 4) 5)))) -- pair TR opt: derived-pair3.rkt 114:0 (cdaddr (cons 1 (cons 2 (cons (cons 3 4) 5)))) -- pair TR opt: derived-pair3.rkt 114:0 (cdaddr (cons 1 (cons 2 (cons (cons 3 4) 5)))) -- pair -TR opt: derived-pair3.rkt 114:0 (cdaddr (cons 1 (cons 2 (cons (cons 3 4) 5)))) -- derived pair + TR opt: derived-pair3.rkt 115:0 (cddaar (cons (cons (cons 1 (cons 2 3)) 4) 5)) -- pair TR opt: derived-pair3.rkt 115:0 (cddaar (cons (cons (cons 1 (cons 2 3)) 4) 5)) -- pair TR opt: derived-pair3.rkt 115:0 (cddaar (cons (cons (cons 1 (cons 2 3)) 4) 5)) -- pair TR opt: derived-pair3.rkt 115:0 (cddaar (cons (cons (cons 1 (cons 2 3)) 4) 5)) -- pair -TR opt: derived-pair3.rkt 115:0 (cddaar (cons (cons (cons 1 (cons 2 3)) 4) 5)) -- derived pair + TR opt: derived-pair3.rkt 116:0 (cddadr (cons 1 (cons (cons 2 (cons 3 4)) 5))) -- pair TR opt: derived-pair3.rkt 116:0 (cddadr (cons 1 (cons (cons 2 (cons 3 4)) 5))) -- pair TR opt: derived-pair3.rkt 116:0 (cddadr (cons 1 (cons (cons 2 (cons 3 4)) 5))) -- pair TR opt: derived-pair3.rkt 116:0 (cddadr (cons 1 (cons (cons 2 (cons 3 4)) 5))) -- pair -TR opt: derived-pair3.rkt 116:0 (cddadr (cons 1 (cons (cons 2 (cons 3 4)) 5))) -- derived pair + TR opt: derived-pair3.rkt 117:0 (cdddar (cons (cons 1 (cons 2 (cons 3 4))) 5)) -- pair TR opt: derived-pair3.rkt 117:0 (cdddar (cons (cons 1 (cons 2 (cons 3 4))) 5)) -- pair TR opt: derived-pair3.rkt 117:0 (cdddar (cons (cons 1 (cons 2 (cons 3 4))) 5)) -- pair TR opt: derived-pair3.rkt 117:0 (cdddar (cons (cons 1 (cons 2 (cons 3 4))) 5)) -- pair -TR opt: derived-pair3.rkt 117:0 (cdddar (cons (cons 1 (cons 2 (cons 3 4))) 5)) -- derived pair + TR opt: derived-pair3.rkt 118:0 (cddddr (cons 1 (cons 2 (cons 3 (cons 4 5))))) -- pair TR opt: derived-pair3.rkt 118:0 (cddddr (cons 1 (cons 2 (cons 3 (cons 4 5))))) -- pair TR opt: derived-pair3.rkt 118:0 (cddddr (cons 1 (cons 2 (cons 3 (cons 4 5))))) -- pair TR opt: derived-pair3.rkt 118:0 (cddddr (cons 1 (cons 2 (cons 3 (cons 4 5))))) -- pair -TR opt: derived-pair3.rkt 118:0 (cddddr (cons 1 (cons 2 (cons 3 (cons 4 5))))) -- derived pair + 1 2 2 diff --git a/collects/tests/typed-racket/optimizer/tests/list.rkt b/collects/tests/typed-racket/optimizer/tests/list.rkt new file mode 100644 index 00000000..cf7d3c18 --- /dev/null +++ b/collects/tests/typed-racket/optimizer/tests/list.rkt @@ -0,0 +1,32 @@ +#; +( +TR opt: list.rkt 27:0 (first l) -- pair +TR opt: list.rkt 28:0 (rest l) -- pair +TR opt: list.rkt 29:0 (second l) -- pair +TR opt: list.rkt 29:0 (second l) -- pair +TR missed opt: list.rkt 30:0 (rest (rest l)) -- car/cdr on a potentially empty list -- caused by: 30:6 (rest l) +TR opt: list.rkt 30:6 (rest l) -- pair +TR opt: list.rkt 31:0 (third l) -- pair +TR opt: list.rkt 31:0 (third l) -- pair +TR opt: list.rkt 31:0 (third l) -- pair +TR opt: list.rkt 32:0 (fourth l) -- pair +TR opt: list.rkt 32:0 (fourth l) -- pair +TR opt: list.rkt 32:0 (fourth l) -- pair +TR opt: list.rkt 32:0 (fourth l) -- pair +1 +'(2 3 4) +2 +'(3 4) +3 +4 +) + +#lang typed/racket + +(define: l : (List Integer Integer Integer Integer) '(1 2 3 4)) +(first l) +(rest l) +(second l) +(rest (rest l)) +(third l) +(fourth l) diff --git a/collects/typed-racket/optimizer/pair.rkt b/collects/typed-racket/optimizer/pair.rkt index ffdae500..24d2bccd 100644 --- a/collects/typed-racket/optimizer/pair.rkt +++ b/collects/typed-racket/optimizer/pair.rkt @@ -2,7 +2,7 @@ (require syntax/parse unstable/syntax racket/match - (for-template scheme/base scheme/unsafe/ops) + (for-template scheme/base scheme/unsafe/ops racket/list) "../utils/utils.rkt" (utils tc-utils) (rep type-rep) @@ -48,9 +48,8 @@ (define-syntax-class pair-opt-expr #:commit (pattern e:pair-derived-opt-expr - #:with opt - (begin (log-optimization "derived pair" pair-opt-msg this-syntax) - #'e.opt)) + ;; no logging here, redundant with actual pair opt + #:with opt #'e.opt) (pattern (#%plain-app op:pair-op p:expr) #:when (or (has-pair-type? #'p) ;; in this case, we have a potentially empty list, but @@ -131,6 +130,7 @@ (cdddar #'cdr #'cdr #'cdr #'car) (cddddr #'cdr #'cdr #'cdr #'cdr) (first #'car) + (rest #'cdr) (second #'car #'cdr) (third #'car #'cdr #'cdr) (fourth #'car #'cdr #'cdr #'cdr)