From 2b9b16b165cecd1285e80545efee84bf340ac36d Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Sat, 8 Feb 2014 15:32:54 -0500 Subject: [PATCH] Add an ignore-table for TR's optimizer This allows the typechecker to tell the optimizer or other downstream analyses what expressions to ignore because they contain non-typechecked code. Use it to fix handling of `send` --- .../typed-racket/optimizer/optimizer.rkt | 6 +++- .../typed-racket/typecheck/tc-expr-unit.rkt | 6 ++++ .../typed-racket/typecheck/tc-toplevel.rkt | 1 + .../typed-racket/types/type-table.rkt | 28 ++++++++++++++++++- 4 files changed, 39 insertions(+), 2 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/optimizer.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/optimizer.rkt index bcc17556ec..f00443c1bd 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/optimizer.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/optimizer.rkt @@ -3,6 +3,7 @@ (require syntax/parse racket/pretty "../utils/utils.rkt" (private syntax-properties) + (types type-table) (optimizer utils number fixnum float float-complex vector string list pair sequence box struct dead-code apply unboxed-let @@ -18,7 +19,10 @@ #:literal-sets (kernel-literals) #:attributes (opt) ;; Can't optimize this code because it isn't typechecked - (pattern (~or opt:ignore^ opt:ignore-some^ opt:exn-handlers^)) + (pattern opt:ignore^) + + ;; Same as above, but if the stx is in the ignore table + (pattern opt:ignore-table^) ;; Can't optimize the body of this code because it isn't typechecked (pattern (~and _:kw-lambda^ diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt index 580c837f91..579b386a8e 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt @@ -185,8 +185,10 @@ (syntax-parse form #:literal-sets (kernel-literals tc-expr-literals) [stx:exn-handlers^ + (register-ignored! form) (check-subforms/with-handlers/check form expected)] [stx:ignore-some^ + (register-ignored! form) (check-subforms/ignore form) ;; We trust ignore to be only on syntax objects objects that are well typed expected] @@ -267,6 +269,7 @@ (if wrapped-object-check ignore-this-case (#%plain-app _ _ _arg-var2 ...)))))) + (register-ignored! form) (tc/send #'find-app #'rcvr #'meth #'(args ...) expected)] ;; kw function def [(~and (let-values ([(f) fun]) . body) _:kw-lambda^) @@ -321,8 +324,10 @@ #:literal-sets (kernel-literals tc-expr-literals) ;; [stx:exn-handlers^ + (register-ignored! form) (check-subforms/with-handlers form) ] [stx:ignore-some^ + (register-ignored! form) (check-subforms/ignore form) (ret Univ)] ;; explicit failure @@ -364,6 +369,7 @@ (if wrapped-object-check ignore-this-case (#%plain-app _ _ _arg-var2 ...)))))) + (register-ignored! form) (tc/send #'find-app #'rcvr #'meth #'(args ...))] ;; kw function def [(~and _:kw-lambda^ diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt index c0b7b56415..e98e6182a7 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt @@ -165,6 +165,7 @@ ;; this is a form that we mostly ignore, but we check some interior parts [stx:ignore-some^ + (register-ignored! form) (check-subforms/ignore form)] ;; these forms should always be ignored diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt index c1e72f8e1d..c7d847d327 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/type-table.rkt @@ -6,6 +6,7 @@ ;; TODO figure out why these imports are needed even though they don't seem to be. (require racket/match + syntax/parse "../utils/utils.rkt" (contract-req) (types utils union) @@ -22,7 +23,14 @@ [contradiction? (syntax? . -> . boolean?)] [neither? (syntax? . -> . boolean?)] [add-dead-lambda-branch (syntax? . -> . any)] - [dead-lambda-branch? (syntax? . -> . boolean?)]) + [dead-lambda-branch? (syntax? . -> . boolean?)] + [;; Register that the given expression should be ignored + register-ignored! (syntax? . -> . any)] + [;; Look up whether a given expression is ignored + is-ignored? (syntax? . -> . boolean?)]) + +(provide ;; Syntax class for is-ignored? + ignore-table^) (define table (make-hasheq)) @@ -83,3 +91,21 @@ (hash-set! lambda-dead-table formals #t))) (define (dead-lambda-branch? formals) (hash-ref lambda-dead-table formals #f)) + +;; The following provides functions for manipulating the ignore-table, which +;; stores expressions that should be ignored for type-checking, optimization, +;; and other type-related analyses. +;; +;; Since the type-checker doesn't add annotations to its input syntax, if +;; the type-checker discovers that something should be ignored by future +;; passes, it needs to use this side-channel. +(define ignore-table (make-hasheq)) + +(define (register-ignored! stx) + (hash-set! ignore-table stx #t)) + +(define (is-ignored? stx) + (hash-ref ignore-table stx #f)) + +(define-syntax-class ignore-table^ + (pattern _ #:when (is-ignored? this-syntax)))