Handle submodules in Typed Racket.
original commit: 39e014bc55779699cc3a503dd9b7416c9f7d28a6
This commit is contained in:
parent
85926af92d
commit
9c7c233e9d
18
collects/tests/typed-racket/fail/submod-req-cnt.rkt
Normal file
18
collects/tests/typed-racket/fail/submod-req-cnt.rkt
Normal file
|
@ -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))
|
14
collects/tests/typed-racket/succeed/module-plus.rkt
Normal file
14
collects/tests/typed-racket/succeed/module-plus.rkt
Normal file
|
@ -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)))
|
11
collects/tests/typed-racket/succeed/req-type-sub.rkt
Normal file
11
collects/tests/typed-racket/succeed/req-type-sub.rkt
Normal file
|
@ -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))
|
11
collects/tests/typed-racket/succeed/submodules.rkt
Normal file
11
collects/tests/typed-racket/succeed/submodules.rkt
Normal file
|
@ -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)))))
|
||||
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user