From 5883e7e81829dd6fa6a9f29f90dfe65d4137b395 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Sun, 27 Jun 2010 20:07:54 -0400 Subject: [PATCH] Use get-type/infer for un-annotated defines. original commit: 0bae63b516a3081276aefd1e2d46b28eba4f31be --- .../typed-scheme/typecheck/tc-toplevel.rkt | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/collects/typed-scheme/typecheck/tc-toplevel.rkt b/collects/typed-scheme/typecheck/tc-toplevel.rkt index 4fab6fc5..3b6d5d14 100644 --- a/collects/typed-scheme/typecheck/tc-toplevel.rkt +++ b/collects/typed-scheme/typecheck/tc-toplevel.rkt @@ -34,8 +34,6 @@ (define unann-defs (make-free-id-table)) (define (tc-toplevel/pass1 form) - ;(printf "form-top: ~a~n" form) - ;; first, find the mutated variables: (parameterize ([current-orig-stx form]) (syntax-parse form #: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) (for-each finish-register-type 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 - [(= 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)])] + ;; special case to infer types for top level defines [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 [(begin . rest)