diff --git a/collects/tests/typed-scheme/optimizer/tests/module-path.rkt b/collects/tests/typed-scheme/optimizer/tests/module-path.rkt new file mode 100644 index 0000000000..efd7c8c50c --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/tests/module-path.rkt @@ -0,0 +1,12 @@ +#; +( +TR opt: module-path.rkt 12:0 (unless (module-path? 2) #f) -- dead then branch +#t +#f +#f +) + +#lang typed/racket #:optimize +(if (module-path? "a") #t #f) +(if (module-path? "\0") #t #f) +(unless (module-path? 2) #f) diff --git a/collects/typed-scheme/base-env/base-env.rkt b/collects/typed-scheme/base-env/base-env.rkt index 7ab25b4f86..d264c39985 100644 --- a/collects/typed-scheme/base-env/base-env.rkt +++ b/collects/typed-scheme/base-env/base-env.rkt @@ -1582,7 +1582,8 @@ [resolved-module-path? (make-pred-ty -Resolved-Module-Path)] [make-resolved-module-path (-> (Un -Symbol -Path) -Resolved-Module-Path)] [resolved-module-path-name (-> -Resolved-Module-Path (Un -Path -Symbol))] -[module-path? (make-pred-ty -Module-Path)] +[module-path? (asym-pred Univ B (-FS (-filter -Module-Path 0) -top))] + [current-module-name-resolver (-Param (cl->* (-Resolved-Module-Path . -> . Univ) ((Un -Module-Path -Path) (-opt -Resolved-Module-Path) diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt index fade99b8da..7a5a2f1c4f 100644 --- a/collects/typed-scheme/types/abbrev.rkt +++ b/collects/typed-scheme/types/abbrev.rkt @@ -157,7 +157,6 @@ (define -Char (make-Base 'Char #'char? char? #'-Char)) (define -Thread (make-Base 'Thread #'thread? thread? #'-Thread)) (define -Resolved-Module-Path (make-Base 'Resolved-Module-Path #'resolved-module-path? resolved-module-path? #'-Resolved-Module-Path)) -(define -Module-Path (make-Base 'Module-Path #'module-path? module-path? #'-Module-Path)) (define -Module-Path-Index (make-Base 'Module-Path-Index #'module-path-index? module-path-index? #'-Module-Path-Index)) (define -Compiled-Module-Expression (make-Base 'Compiled-Module-Expression #'compiled-module-expression? compiled-module-expression? #'-Compiled-Module-Expression)) (define -Prompt-Tag (make-Base 'Prompt-Tag #'continuation-prompt-tag? continuation-prompt-tag? #'-Prompt-Tag)) diff --git a/collects/typed-scheme/types/convenience.rkt b/collects/typed-scheme/types/convenience.rkt index 575ef788d7..e38732a7f6 100644 --- a/collects/typed-scheme/types/convenience.rkt +++ b/collects/typed-scheme/types/convenience.rkt @@ -86,3 +86,14 @@ (define Ident (-Syntax -Symbol)) + +(define -Module-Path (*Un -Symbol -String + (-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))))))))) + +