diff --git a/collects/tests/typed-racket/fail/submod-req-cnt.rkt b/collects/tests/typed-racket/fail/submod-req-cnt.rkt new file mode 100644 index 00000000..51cc7092 --- /dev/null +++ b/collects/tests/typed-racket/fail/submod-req-cnt.rkt @@ -0,0 +1,18 @@ +#; +(exn-pred exn:fail:contract?) +#lang racket/load + +(module outer typed/racket + (: f : Integer -> Integer) + (define (f x) (add1 x)) + + (provide f) + + (module* m racket + (require (submod "..")) + (f "foo")) + + (module* main racket + (require (submod ".." m)))) + +(require (submod 'outer main)) diff --git a/collects/tests/typed-racket/succeed/module-plus.rkt b/collects/tests/typed-racket/succeed/module-plus.rkt new file mode 100644 index 00000000..e203182b --- /dev/null +++ b/collects/tests/typed-racket/succeed/module-plus.rkt @@ -0,0 +1,14 @@ +#lang typed/racket + +(: f : Integer -> Integer) +(define (f x) x) + +(module+ main + (: g : Integer -> Integer) + (f (+ 3 5))) + +(module+ main + (define (g x) (add1 x))) + +(module+ main + (g (f 7))) diff --git a/collects/tests/typed-racket/succeed/req-type-sub.rkt b/collects/tests/typed-racket/succeed/req-type-sub.rkt new file mode 100644 index 00000000..0f141e99 --- /dev/null +++ b/collects/tests/typed-racket/succeed/req-type-sub.rkt @@ -0,0 +1,11 @@ +#lang racket + +(define (f x) (add1 x)) +(provide f) +(module* m typed/racket + (require/typed (submod "..") [f (Integer -> Integer)]) + (f 7)) + +(module* n typed/racket + (require/typed (submod "..") [f (Integer -> String)]) + (f 7)) diff --git a/collects/tests/typed-racket/succeed/submodules.rkt b/collects/tests/typed-racket/succeed/submodules.rkt new file mode 100644 index 00000000..2e79f827 --- /dev/null +++ b/collects/tests/typed-racket/succeed/submodules.rkt @@ -0,0 +1,11 @@ +#lang typed/racket + +(: g : Number -> Number) +(define (g x) (add1 x)) + +(provide g) + +(module+ main + (g (assert (string->number + (vector-ref (current-command-line-arguments) 0))))) + diff --git a/collects/typed-racket/tc-setup.rkt b/collects/typed-racket/tc-setup.rkt index 320ba3c5..fce91f20 100644 --- a/collects/typed-racket/tc-setup.rkt +++ b/collects/typed-racket/tc-setup.rkt @@ -59,8 +59,8 @@ ;; reinitialize disappeared uses [disappeared-use-todo null] [disappeared-bindings-todo null]) - (define fully-expanded-stx (disarm* (local-expand stx expand-ctxt null))) - (when (show-input?) + (define fully-expanded-stx (disarm* (local-expand stx expand-ctxt (list #'module*)))) + (when #t (pretty-print (syntax->datum fully-expanded-stx))) (do-time "Local Expand Done") (init) diff --git a/collects/typed-racket/typecheck/tc-toplevel.rkt b/collects/typed-racket/typecheck/tc-toplevel.rkt index 9b89c9eb..3716021f 100644 --- a/collects/typed-racket/typecheck/tc-toplevel.rkt +++ b/collects/typed-racket/typecheck/tc-toplevel.rkt @@ -58,6 +58,12 @@ #:when (or (syntax-property form 'typechecker:ignore) (syntax-property form 'typechecker:ignore-some)) (list)] + + [((~literal module) n:id spec ((~literal #%plain-module-begin) body ...)) + (list)] + ;; module* is not expanded, so it doesn't have a `#%plain-module-begin` + [((~literal module*) n:id spec body ...) + (list)] ;; type aliases have already been handled by an earlier pass [(define-values () (begin (quote-syntax (define-type-alias-internal nm ty)) (#%plain-app values))) @@ -172,7 +178,7 @@ (define (tc-toplevel/pass2 form) (parameterize ([current-orig-stx form]) (kernel-syntax-case* form #f (define-type-alias-internal define-typed-struct-internal define-type-internal - require/typed-internal values) + require/typed-internal values module module*) ;; these forms we have been instructed to ignore [stx (syntax-property form 'typechecker:ignore) @@ -197,6 +203,13 @@ (void)] [(define-values () (begin (quote-syntax (define-typed-struct-internal . rest)) (#%plain-app values))) (void)] + + ;; submodules take care of themselves: + [(module n spec (#%plain-module-begin body ...)) + (void)] + ;; module* is not expanded, so it doesn't have a `#%plain-module-begin` + [(module* n spec body ...) + (void)] ;; definitions just need to typecheck their bodies [(define-values (var ...) expr)