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

Use get-type/infer for un-annotated defines.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-06-27 20:07:54 -04:00
parent 90d8a3cc13
commit 0bae63b516
1 changed files with 7 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/typed-scheme/typecheck/tc-toplevel.rkt
View File

@ -34,8 +34,6 @@
(define unann-defs (make-free-id-table)) (define unann-defs (make-free-id-table))
(define (tc-toplevel/pass1 form) (define (tc-toplevel/pass1 form)
;(printf "form-top: ~a~n" form)
;; first, find the mutated variables:
(parameterize ([current-orig-stx form]) (parameterize ([current-orig-stx form])
(syntax-parse form (syntax-parse form
#:literals (values define-type-alias-internal define-typed-struct-internal define-type-internal #:literals (values define-type-alias-internal define-typed-struct-internal define-type-internal
@ -137,16 +135,14 @@
[(andmap (lambda (s) (lookup-type s (lambda () #f))) vars) [(andmap (lambda (s) (lookup-type s (lambda () #f))) vars)
(for-each finish-register-type vars) (for-each finish-register-type vars)
(map (lambda (s) (make-def-binding s (lookup-type s))) vars)] (map (lambda (s) (make-def-binding s (lookup-type s))) vars)]
;; special case to infer types for top level defines - should handle the multiple values case here ;; special case to infer types for top level defines
[(= 1 (length vars))
(match (tc-expr #'expr)
[(tc-result1: t)
(register-type (car vars) t)
(free-id-table-set! unann-defs (car vars) #t)
(list (make-def-binding (car vars) t))]
[t (int-err "~a is not a tc-result" t)])]
[else [else
(tc-error "Untyped definition : ~a" (map syntax-e vars))]))] (match (get-type/infer vars #'expr tc-expr tc-expr/check)
[(tc-results: ts)
(for/list ([i (in-list vars)] [t (in-list ts)])
(register-type i t)
(free-id-table-set! unann-defs i #t)
(make-def-binding i t))])]))]
;; to handle the top-level, we have to recur into begins ;; to handle the top-level, we have to recur into begins
[(begin . rest) [(begin . rest)