suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adjust handling of types for non-expressions

Browse Source 
Some forms like `define` do not produce a value
and thus do not have a type. Instead of returning
the #<void> 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
This commit is contained in:
Asumu Takikawa 2014-02-27 15:31:21 -05:00
parent 7cd4da639f
commit f579129af8
5 changed files with 48 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/top-interaction.rkt
View File

@ -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)]))

9
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/core.rkt
View File

@ -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)))]))))]))

8
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/tc-setup.rkt
View File

@ -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?)

27
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
View File

@ -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

20
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/interactive-tests.rkt
View File

@ -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))