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

Change Module-Path type to accommodate submodules

Browse Source 
Closes #84
This commit is contained in:
Asumu Takikawa 2015-06-10 12:21:51 -04:00
parent 91e3a1b5f0
commit bc3443b393
2 changed files with 35 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
typed-racket-lib/typed-racket/types/abbrev.rkt
View File

@ -121,20 +121,23 @@
(define/decl -Thread (make-Base 'Thread #'thread? thread?))
(define/decl -Path (make-Base 'Path #'path? path?))
(define/decl -Module-Path
(Un -Symbol -String -Path
(-lst* (-val 'quote) -Symbol)
(-lst* (-val 'lib) -String)
(-lst* (-val 'file) -String)
(-pair (-val 'planet)
(Un (-lst* -Symbol)
(-lst* -String)
(-lst* -String
(-lst*
-String -String
#:tail (make-Listof
(Un -Nat
(-lst* (Un -Nat (one-of/c '= '+ '-))
-Nat)))))))))
(-mu X
(Un -Symbol -String -Path
(-lst* (-val 'quote) -Symbol)
(-lst* (-val 'lib) -String)
(-lst* (-val 'file) -String)
(-pair (-val 'planet)
(Un (-lst* -Symbol)
(-lst* -String)
(-lst* -String
(-lst*
-String -String
#:tail (make-Listof
(Un -Nat
(-lst* (Un -Nat (one-of/c '= '+ '-))
-Nat)))))))
(-lst* (-val 'submod) X
#:tail (-lst (Un -Symbol (-val "..")))))))
(define/decl -Resolved-Module-Path (make-Base 'Resolved-Module-Path #'resolved-module-path? resolved-module-path?))
(define/decl -Module-Path-Index (make-Base 'Module-Path-Index #'module-path-index? module-path-index?))
(define/decl -Compiled-Module-Expression (make-Base 'Compiled-Module-Expression #'compiled-module-expression? compiled-module-expression?))

18
typed-racket-test/unit-tests/typecheck-tests.rkt
View File

@ -3740,6 +3740,24 @@
(-result -Boolean (-FS (-filter -NonPosFlonum 0) -top))
(-result -Boolean)
(-result -Boolean))))]
;; Tests for Module-Path
[tc-e/t (ann "x" Module-Path) -Module-Path]
[tc-e/t (ann 'x Module-Path) -Module-Path]
[tc-e/t (ann '(planet x) Module-Path) -Module-Path]
[tc-e/t (ann '(planet "foo") Module-Path) -Module-Path]
[tc-e/t (ann '(planet "foo" ("x" "y" 1 2)) Module-Path) -Module-Path]
[tc-e/t (ann '(submod "foo" foo) Module-Path) -Module-Path]
[tc-e/t (ann '(submod "." bar) Module-Path) -Module-Path]
[tc-e/t (ann '(submod ".." bar) Module-Path) -Module-Path]
;; Need an `ann` here because TR doesn't typecheck the literal ".."
;; with a precise enough type to satisfy Module-Path
[tc-e (ann `(submod ".." bar ,(ann ".." "..")) Module-Path)
#:ret (ret -Module-Path)
#:expected (ret -Module-Path)]
[tc-e/t (ann '(lib "foo") Module-Path) -Module-Path]
[tc-err (begin (ann '(submod ".." bar ".") Module-Path)
(error "foo"))]
)
(test-suite