diff --git a/collects/typed-scheme/private/provide-handling.ss b/collects/typed-scheme/private/provide-handling.ss index b52d2da209..53f2418dbd 100644 --- a/collects/typed-scheme/private/provide-handling.ss +++ b/collects/typed-scheme/private/provide-handling.ss @@ -7,6 +7,7 @@ (lib "stx.ss" "syntax") (lib "etc.ss") (except-in (lib "list.ss") remove) + mzlib/trace "type-contract.ss" "signatures.ss" "tc-structs.ss" @@ -32,13 +33,17 @@ "def-binding.ss" (lib "plt-match.ss")) +(require (for-template scheme/base + scheme/contract)) + (provide remove-provides provide? generate-prov) -(define (provide? form) +(define (provide? form) (kernel-syntax-case form #f [(#%provide . rest) form] [_ #f])) + (define (remove-provides forms) (filter (lambda (e) (not (provide? e))) (syntax->list forms))) @@ -50,7 +55,7 @@ (def-binding-ty (mem? i vd))) (define (mk internal-id external-id) (cond - [(mem? internal-id val-defs) + [(mem? internal-id val-defs) => (lambda (b) (with-syntax ([id internal-id] diff --git a/collects/typed-scheme/private/tc-toplevel.ss b/collects/typed-scheme/private/tc-toplevel.ss index 032eeeb728..5be2d504b2 100644 --- a/collects/typed-scheme/private/tc-toplevel.ss +++ b/collects/typed-scheme/private/tc-toplevel.ss @@ -95,7 +95,7 @@ => (match-lambda [(tc-result: t) (register-type (car vars) t) - (list (car vars) t)])] + (list (make-def-binding (car vars) t))])] [else (tc-error "Untyped definition : ~a" (map syntax-e vars))]))] @@ -217,7 +217,7 @@ ;; resolve all the type aliases, and error if there are cycles (resolve-type-aliases parse-type) ;; do pass 1, and collect the defintions - (define defs (filter list? (map tc-toplevel/pass1 forms))) + (define defs (apply append (filter list? (map tc-toplevel/pass1 forms)))) ;; separate the definitions into structures we'll handle for provides (define stx-defs (filter def-stx-binding? defs)) (define val-defs (filter def-binding? defs)) diff --git a/collects/typed-scheme/private/type-contract.ss b/collects/typed-scheme/private/type-contract.ss index e366ad6dd6..b16cae1ced 100644 --- a/collects/typed-scheme/private/type-contract.ss +++ b/collects/typed-scheme/private/type-contract.ss @@ -74,6 +74,7 @@ [(Input-Port) #'input-port?] [(Char) #'char?] [(Namespace) #'namespace?] + [(Integer) #'integer?] [else (int-err "Base type ~a cannot be converted to contract" sym)])] [(Union: elems) (with-syntax