From f579129af8205db7d68c83dbf5511d456f905d7f Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Thu, 27 Feb 2014 15:31:21 -0500 Subject: [PATCH] Adjust handling of types for non-expressions Some forms like `define` do not produce a value and thus do not have a type. Instead of returning the # value for these cases, return the symbol 'no-type. Also fix printing in several places to reflect this. Fixes a regression due to commit 00470e3 and also fixes an unreported bug with (:print-type ...) on non-expressions. Closes PR 13758 original commit: 1747b700976a664ec7ee5a9004e02a173910a2e2 --- .../typed-racket/base-env/top-interaction.rkt | 12 +++++---- .../typed-racket-lib/typed-racket/core.rkt | 9 ++++--- .../typed-racket/tc-setup.rkt | 8 +----- .../typed-racket/typecheck/tc-toplevel.rkt | 27 ++++++++++--------- .../unit-tests/interactive-tests.rkt | 20 ++++++++++++++ 5 files changed, 48 insertions(+), 28 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/top-interaction.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/top-interaction.rkt index d53857e5..2ef88f96 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/top-interaction.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/top-interaction.rkt @@ -80,11 +80,13 @@ (tc-toplevel/full stx #'e (λ (expanded type) #`(display - #,(pretty-format-type - (match type - [(tc-result1: t f o) t] - [(tc-results: t) (-values t)] - [(tc-any-results:) ManyUniv])))))] + #,(if (eq? type 'no-type) + "This form has no type (it does not produce a value)." + (pretty-format-type + (match type + [(tc-result1: t f o) t] + [(tc-results: t) (-values t)] + [(tc-any-results:) ManyUniv]))))))] [form (raise-syntax-error #f "must be applied to exactly one argument" #'form)])) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/core.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/core.rkt index b73388a9..f3888c42 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/core.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/core.rkt @@ -66,9 +66,10 @@ (with-syntax* ([(optimized-body . _) (maybe-optimize #`(#,body2))]) (syntax-parse body2 - ;; any of these do not produce an expression to be printed - [(head:invis-kw . _) (arm #'optimized-body)] [_ (let ([ty-str (match type + ;; 'no-type means the form is not an expression and + ;; has no meaningful type to print + ['no-type #f] ;; don't print results of type void [(tc-result1: (== -Void type-equal?)) #f] @@ -110,6 +111,6 @@ :print-type-message]))] [x (int-err "bad type result: ~a" x)])]) (if ty-str - #`(let ([type '#,ty-str]) - (begin0 #,(arm #'optimized-body) (display type))) + #`(begin (display '#,ty-str) + #,(arm #'optimized-body)) (arm #'optimized-body)))]))))])) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/tc-setup.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/tc-setup.rkt index 1022c0a7..ef9de318 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/tc-setup.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/tc-setup.rkt @@ -12,16 +12,10 @@ (lazy-require [typed-racket/optimizer/optimizer (optimize-top)]) (lazy-require [typed-racket/typecheck/tc-toplevel (tc-toplevel-form tc-module)]) -(provide invis-kw maybe-optimize init-current-type-names +(provide maybe-optimize init-current-type-names tc-module/full tc-toplevel/full) -(define-syntax-class invis-kw - #:literals (define-values define-syntaxes #%require - #%provide #%declare begin begin-for-syntax) - (pattern (~or define-values define-syntaxes #%require - #%provide #%declare begin begin-for-syntax))) - (define (maybe-optimize body) ;; do we optimize? (if (optimize?) 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 cf8c431b..816ec297 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 @@ -154,7 +154,7 @@ ;; typecheck the expressions of a module-top-level form ;; no side-effects -;; syntax? -> (or/c void? tc-results/c) +;; syntax? -> (or/c 'no-type tc-results/c) (define (tc-toplevel/pass2 form) (parameterize ([current-orig-stx form]) (syntax-parse form @@ -165,7 +165,7 @@ ;; these forms we have been instructed to ignore [stx:ignore^ - (void)] + 'no-type] ;; this is a form that we mostly ignore, but we check some interior parts [stx:ignore-some^ @@ -173,28 +173,30 @@ (check-subforms/ignore form)] ;; these forms should always be ignored - [((~or define-syntaxes begin-for-syntax #%require #%provide #%declare) . _) (void)] + [((~or define-syntaxes begin-for-syntax #%require #%provide #%declare) . _) 'no-type] ;; submodules take care of themselves: - [(module n spec (#%plain-module-begin body ...)) (void)] + [(module n spec (#%plain-module-begin body ...)) 'no-type] ;; module* is not expanded, so it doesn't have a `#%plain-module-begin` - [(module* n spec body ...) (void)] + [(module* n spec body ...) 'no-type] ;; definitions just need to typecheck their bodies [(define-values () expr) - (tc-expr/check #'expr (ret empty))] + (tc-expr/check #'expr (ret empty)) + 'no-type] [(define-values (var ...) expr) #:when (for/and ([v (in-syntax #'(var ...))]) (free-id-table-ref unann-defs v (lambda _ #f))) - (void)] + 'no-type] [(define-values (var:typed-id^ ...) expr) (let ([ts (attribute var.type)]) (when (= 1 (length ts)) (add-scoped-tvars #'expr (lookup-scoped-tvars (stx-car #'(var ...))))) - (tc-expr/check #'expr (ret ts))) ] + (tc-expr/check #'expr (ret ts))) + 'no-type] ;; to handle the top-level, we have to recur into begins - [(begin) (void)] + [(begin) 'no-type] [(begin . rest) (for/last ([form (in-syntax #'rest)]) (tc-toplevel/pass2 form))] @@ -357,15 +359,16 @@ ;; typecheck a top-level form ;; used only from #%top-interaction -;; syntax -> (or/c void? tc-results/c) +;; syntax -> (or/c 'no-type tc-results/c) (define (tc-toplevel-form form) (syntax-parse form ;; Don't open up `begin`s that are supposed to be ignored [(~and ((~literal begin) e ...) (~not (~or _:ignore^ _:ignore-some^))) (begin0 - (for/last ([form (in-syntax #'(e ...))]) - (tc-toplevel-form form)) + (or (for/last ([form (in-syntax #'(e ...))]) + (tc-toplevel-form form)) + 'no-type) (report-all-errors))] [_ ;; Handle type aliases 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 6dbb4286..cb1dfc33 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 @@ -74,6 +74,22 @@ #rx"" (define module displayln) #rx"racket" (module 'racket)) + (test-form (regexp-quote "String") + "foo") + (test-form (regexp-quote "String") + (begin "foo")) + (test-form (regexp-quote "String") + (begin "foo" "bar")) + (test-form #rx"^$" + (begin)) + (test-form #rx"^$" + (define x "foo")) + (test-form #rx"^$" + (begin (: x String) + (define x "foo"))) + (test-form #rx"^$" + (struct foo ())) + (test-form #rx"1" (:type 1)) (test-form (regexp-quote "(U Positive-Byte Zero)") @@ -103,6 +119,10 @@ (:print-type)) (test-form-exn #rx"exactly one argument" (:print-type 1 2)) + (test-form (regexp-quote "has no type") + (:print-type (begin (begin)))) + (test-form (regexp-quote "has no type") + (:print-type (require racket/format))) (test-form (regexp-quote "(-> 4 Zero Zero)") (:query-type/args * 4 0))