From 07bde5063b5a3a83f61e85f00a1c6ce6e0a097d2 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Fri, 28 Feb 2014 20:08:23 -0500 Subject: [PATCH] Add #:literal-sets for several TR optimizer cases The matching was too inclusive in some cases, causing spurious optimizations (or type-table lookup failures). Closes PR 14380 --- .../typed-racket-lib/typed-racket/optimizer/box.rkt | 1 + .../typed-racket/optimizer/float-complex.rkt | 2 ++ .../typed-racket/optimizer/float.rkt | 1 + .../typed-racket/optimizer/list.rkt | 1 + .../typed-racket/optimizer/number.rkt | 1 + .../typed-racket/optimizer/numeric-utils.rkt | 1 + .../typed-racket/optimizer/pair.rkt | 1 + .../typed-racket/optimizer/sequence.rkt | 1 + .../typed-racket/optimizer/string.rkt | 1 + .../typed-racket/optimizer/struct.rkt | 1 + .../typed-racket/optimizer/unboxed-let.rkt | 1 + .../typed-racket/unit-tests/interactive-tests.rkt | 13 +++++++++++++ 12 files changed, 25 insertions(+) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/box.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/box.rkt index bd5ef47c49..246a5916a7 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/box.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/box.rkt @@ -18,6 +18,7 @@ (define-syntax-class box-opt-expr #:commit + #:literal-sets (kernel-literals) (pattern (#%plain-app op:box-op b:opt-expr new:opt-expr ...) #:do [(log-opt "box" "Box check elimination.")] #:with opt #`(op.unsafe b.opt new.opt ...))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float-complex.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float-complex.rkt index 55579cc9b4..570290e1eb 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float-complex.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float-complex.rkt @@ -364,6 +364,7 @@ (define-syntax-class float-complex-opt-expr #:commit #:attributes (opt) + #:literal-sets (kernel-literals) ;; Dummy pattern that can't actually match. ;; We just want to detect "unexpected" Complex _types_ that come up. ;; (not necessarily complex _values_, in fact, most of the time this @@ -418,6 +419,7 @@ (define-syntax-class (float-complex-arith-expr* optimizing) #:commit #:attributes (opt) + #:literal-sets (kernel-literals) ;; we can optimize taking the real of imag part of an unboxed complex ;; hopefully, the compiler can eliminate unused bindings for the other part if it's not used diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt index 054871793e..968b0e1fe2 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt @@ -65,6 +65,7 @@ (define-syntax-class float-arg-expr #:commit #:attributes (opt) + #:literal-sets (kernel-literals) ;; we can convert literals right away (pattern (quote n) #:when (and (real? (syntax->datum #'n)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/list.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/list.rkt index ada38850ac..965444cfd7 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/list.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/list.rkt @@ -28,6 +28,7 @@ (define-syntax-class list-opt-expr #:commit + #:literal-sets (kernel-literals) ;; Similar to known-length vectors opts. ;; If we use `list-ref' or `list-tail' on a known-length list with a ;; literal index, we can optimize if the index is within bounds. diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/number.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/number.rkt index 4295243924..f9b71b5c6f 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/number.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/number.rkt @@ -26,6 +26,7 @@ (define-syntax-class number-opt-expr #:commit + #:literal-sets (kernel-literals) ;; these cases are all identity (pattern (#%plain-app op:unary-op f:opt-expr) #:do [(log-opt "unary number" "Identity elimination.")] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/numeric-utils.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/numeric-utils.rkt index 9c50b1beb2..2d2fab6f37 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/numeric-utils.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/numeric-utils.rkt @@ -26,6 +26,7 @@ (not (subtypeof? t -Real)))) (define-syntax-class arith-expr + #:literal-sets (kernel-literals) (pattern (#%plain-app op:arith-op args ...))) (define-syntax-class arith-op (pattern diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/pair.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/pair.rkt index b8a9f8b604..62f41789fa 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/pair.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/pair.rkt @@ -46,6 +46,7 @@ (define-syntax-class pair-opt-expr #:commit #:attributes (opt) + #:literal-sets (kernel-literals) ;; no logging here, redundant with actual pair opt (pattern :pair-derived-opt-expr) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/sequence.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/sequence.rkt index a18d1f22e6..e0370a4dd7 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/sequence.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/sequence.rkt @@ -42,6 +42,7 @@ (define-syntax-class sequence-opt-expr #:commit + #:literal-sets (kernel-literals) ;; 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:make-sequence _ l:list-expr) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/string.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/string.rkt index eb09388894..a1371a9104 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/string.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/string.rkt @@ -15,6 +15,7 @@ (define-syntax-class string-opt-expr #:commit + #:literal-sets (kernel-literals) (pattern (#%plain-app op:string-length^ s:opt-expr) #:do [(log-opt "string-length" "String check elimination.")] #:with opt #'(op.unsafe s.opt)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/struct.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/struct.rkt index 8bea4c89ef..bcf9313e1d 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/struct.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/struct.rkt @@ -26,6 +26,7 @@ (define-syntax-class struct-opt-expr #:commit + #:literal-sets (kernel-literals) ;; we can always optimize struct accessors and mutators ;; if they typecheck, they're safe (pattern (#%plain-app op:struct-op s:opt-expr v:opt-expr ...) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt index 3f77fd9d2e..9ab9a73498 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/unboxed-let.rkt @@ -259,6 +259,7 @@ (define-syntax-class unbox-fun-clause #:commit #:attributes ([bindings 1]) + #:literal-sets (kernel-literals) (pattern ((fun:unboxed-fun) (#%plain-lambda params body:opt-expr ...)) #:with (real-params ...) (stx-map (lambda (x) (generate-temporary "unboxed-real-")) #'(fun.unboxed ...)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt index cb1dfc3369..2686ae5427 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt @@ -52,6 +52,16 @@ (eval `(#%top-interaction . ,(syntax->datum #'form)) (get-ns f.fresh))))))])) +(define-syntax (test-form-not-exn stx) + (syntax-parse stx + [(_ f:fresh-kw form:expr) + (quasisyntax/loc stx + (test-case #,(~a (syntax->datum #'form)) + (check-not-exn + (lambda () + (eval `(#%top-interaction . + ,(syntax->datum #'form)) (get-ns f.fresh))))))])) + (define-syntax (test-form stx) (syntax-parse stx [(_ f:fresh-kw (~seq regexp:expr form:expr) ...) @@ -90,6 +100,9 @@ (test-form #rx"^$" (struct foo ())) + ;; PR 14380 + (test-form-not-exn (begin - (void))) + (test-form #rx"1" (:type 1)) (test-form (regexp-quote "(U Positive-Byte Zero)")