From 4aed44370d4ee11bfe1deb2131c1119c41d0540f Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Tue, 13 Oct 2015 15:31:31 -0500 Subject: [PATCH] Ignore more code that has no types. --- .../typed-racket/typecheck/tc-app/tc-app-keywords.rkt | 3 ++- .../typed-racket/typecheck/tc-app/tc-app-special.rkt | 3 ++- typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt | 4 ++++ typed-racket-test/optimizer/tests/opt-arg.rkt | 7 +++++++ 4 files changed, 15 insertions(+), 2 deletions(-) diff --git a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt index 1328ad3f..f9361fac 100644 --- a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt +++ b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-keywords.rkt @@ -6,7 +6,7 @@ "utils.rkt" syntax/parse syntax/stx racket/match racket/set (typecheck signatures tc-app-helper tc-funapp tc-metafunctions) - (types abbrev utils substitute subtype) + (types abbrev utils substitute subtype type-table) (rep type-rep) (utils tc-utils) (r:infer infer) @@ -35,6 +35,7 @@ ;; If #t, then the contract system has inserted an extra argument which we ;; need to ignore #:attr boundary-ctc? (contract-neg-party-property #'fn) + #:do [(for-each register-ignored! (syntax->list #'form))] ; no type info, so can't optimize #:with pos-args (if (attribute boundary-ctc?) (stx-cdr #'*pos-args) #'*pos-args) diff --git a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-special.rkt b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-special.rkt index 1fee64ce..705be47f 100644 --- a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-special.rkt +++ b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-special.rkt @@ -7,7 +7,7 @@ syntax/stx racket/sequence (typecheck signatures tc-funapp) - (types abbrev utils) + (types abbrev type-table utils) (private type-annotation) (rep type-rep filter-rep) (utils tc-utils) @@ -26,6 +26,7 @@ ;; parameterize (pattern (extend-parameterization pmz (~seq params args) ...) (begin + (register-ignored! #'pmz) (for ([param (in-syntax #'(params ...))] [arg (in-syntax #'(args ...))]) (match (single-value param) diff --git a/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt b/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt index a881b579..451a065a 100644 --- a/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt +++ b/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt @@ -117,6 +117,7 @@ ;; definitions lifted from contracts should be ignored [(define-values (lifted) expr) #:when (contract-lifted-property #'expr) + #:do [(register-ignored! #'expr)] (list)] ;; register types of variables defined by define-values/invoke-unit forms @@ -177,6 +178,7 @@ ;; definitions lifted from contracts should be ignored [(define-values (lifted) expr) #:when (contract-lifted-property #'expr) + #:do [(register-ignored! #'expr)] (list)] [(define-values (var ...) expr) @@ -235,6 +237,7 @@ [expected-type (in-list (map cdr (signature->bindings import-sig)))]) (define lexical-type (lookup-type/lexical member)) (check-below lexical-type expected-type))) + (register-ignored! #'dviu) 'no-type] ;; these forms we have been instructed to ignore [stx:ignore^ @@ -256,6 +259,7 @@ ;; definitions lifted from contracts should be ignored [(define-values (lifted) expr) #:when (contract-lifted-property #'expr) + #:do [(register-ignored! #'expr)] 'no-type] ;; definitions just need to typecheck their bodies diff --git a/typed-racket-test/optimizer/tests/opt-arg.rkt b/typed-racket-test/optimizer/tests/opt-arg.rkt index 8952c3b7..c40c8c60 100644 --- a/typed-racket-test/optimizer/tests/opt-arg.rkt +++ b/typed-racket-test/optimizer/tests/opt-arg.rkt @@ -10,3 +10,10 @@ (define (slicef-at [force? #f]) #f) + + +;; Similar issue, with static call sites for keyword argument functions. +(define (validate-txexpr-element #:context [txexpr-context #f]) + #f) +(define (validate-txexpr x) + (validate-txexpr-element #:context x))