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

Split Path type into Path and OtherSystemPath.

Browse Source
This commit is contained in:
Eric Dobson 2011-05-03 20:45:01 -04:00 committed by Vincent St-Amour
parent 8f6d3c7920
commit 05af2b9e17
4 changed files with 51 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/tests/typed-scheme/succeed/somesystempath.rkt Normal file
View File

@ -0,0 +1,27 @@
#lang typed/racket
(: unix-path SomeSystemPath)
(define unix-path (string->some-system-path "file.rkt" 'unix))
(: windows-path SomeSystemPath)
(define windows-path (string->some-system-path "file.rkt" 'windows))
(for: ((p : SomeSystemPath (list unix-path windows-path)))
(let ((long-path (build-path p 'up 'same p)))
(unless (path-for-some-system? p)
(error "Predicate failed"))
(explode-path long-path)
(filename-extension p)
(path-only long-path)
(some-system-path->string long-path)
))
(when (equal? 'unix (system-path-convention-type))
(find-relative-path (simplify-path (path->complete-path "foo")) (simplify-path (path->complete-path "foo/foo/foo"))))

22
collects/typed-scheme/base-env/base-env.rkt
View File

@ -394,7 +394,7 @@
[string->path (-> -String -Path)] [string->path (-> -String -Path)]
[build-path ((list -Pathlike*) -Pathlike* . ->* . -Path)] [build-path ((list -SomeSystemPathlike*) -SomeSystemPathlike* . ->* . -Path)]
[with-input-from-file [with-input-from-file
(-poly (a) (->key -Pathlike (-> a) #:mode (one-of/c 'binary 'text) #f a))] (-poly (a) (->key -Pathlike (-> a) #:mode (one-of/c 'binary 'text) #f a))]
[with-output-to-file [with-output-to-file
@ -750,6 +750,7 @@
[object-name (Univ . -> . Univ)] [object-name (Univ . -> . Univ)]
[path? (make-pred-ty -Path)] [path? (make-pred-ty -Path)]
[path-for-some-system? (make-pred-ty -SomeSystemPath)]
;; scheme/function ;; scheme/function
[const (-poly (a) (-> a (->* '() Univ a)))] [const (-poly (a) (-> a (->* '() Univ a)))]
@ -843,16 +844,23 @@
;; scheme/path ;; scheme/path
[explode-path (-Pathlike . -> . (-lst (Un -Path (-val 'up) (-val 'same))))] [explode-path (-SomeSystemPathlike . -> . (-lst (Un -SomeSystemPath (-val 'up) (-val 'same))))]
[find-relative-path (-Pathlike -Pathlike . -> . -Path)] [find-relative-path (-SomeSystemPathlike -SomeSystemPathlike . -> . -SomeSystemPath)]
[simple-form-path (-Pathlike . -> . -Path)] [simple-form-path (-Pathlike . -> . -Path)]
[normalize-path (cl->* (-Pathlike [-Pathlike] . ->opt . -Path))] [normalize-path (cl->* (-Pathlike [-Pathlike] . ->opt . -Path))]
[filename-extension (-Pathlike . -> . (-opt -Bytes))] [filename-extension (-SomeSystemPathlike . -> . (-opt -Bytes))]
[file-name-from-path (-Pathlike . -> . (-opt -Path))] [file-name-from-path (-Pathlike . -> . (-opt -Path))]
[path-only (-Pathlike . -> . (-opt -Path))] [path-only (-SomeSystemPathlike . -> . (-opt -Path))]
[some-system-path->string (-Path . -> . -String)] [some-system-path->string (-SomeSystemPath . -> . -String)]
[string->some-system-path [string->some-system-path
(-String (Un (-val 'unix) (-val 'windows)) . -> . -Path)] (-String (Un (-val 'unix) (-val 'windows)) . -> . -SomeSystemPath)]
[simplify-path (-SomeSystemPathlike [B] . ->opt . -SomeSystemPath)]
[path->complete-path
(cl->* (-> -Pathlike -Path)
(-> -SomeSystemPathlike -SomeSystemPathlike -SomeSystemPath))]
[system-path-convention-type (-> (Un (-val 'unix) (-val 'windows)))]
;; scheme/file ;; scheme/file
[fold-files [fold-files

1
collects/typed-scheme/base-env/base-types.rkt
View File

@ -77,6 +77,7 @@
[Any Univ] [Any Univ]
[Port -Port] [Port -Port]
[Path -Path] [Path -Path]
[SomeSystemPath -SomeSystemPath]
[Path-String -Pathlike] [Path-String -Pathlike]
[Regexp -Regexp] [Regexp -Regexp]
[PRegexp -PRegexp] [PRegexp -PRegexp]

9
collects/typed-scheme/types/abbrev.rkt
View File

@ -143,6 +143,10 @@
(define -Prompt-Tag (make-Base 'Prompt-Tag #'continuation-prompt-tag? continuation-prompt-tag? #'-Prompt-Tag)) (define -Prompt-Tag (make-Base 'Prompt-Tag #'continuation-prompt-tag? continuation-prompt-tag? #'-Prompt-Tag))
(define -Cont-Mark-Set (make-Base 'Continuation-Mark-Set #'continuation-mark-set? continuation-mark-set? #'-Cont-Mark-Set)) (define -Cont-Mark-Set (make-Base 'Continuation-Mark-Set #'continuation-mark-set? continuation-mark-set? #'-Cont-Mark-Set))
(define -Path (make-Base 'Path #'path? path? #'-Path)) (define -Path (make-Base 'Path #'path? path? #'-Path))
(define -OtherSystemPath (make-Base 'OtherSystemPath
#'(and/c path-for-some-system? (not/c path?))
(conjoin path-for-some-system? (negate path?))
#'-OtherSystemPath))
(define -Namespace (make-Base 'Namespace #'namespace? namespace? #'-Namespace)) (define -Namespace (make-Base 'Namespace #'namespace? namespace? #'-Namespace))
(define -Output-Port (make-Base 'Output-Port #'output-port? output-port? #'-Output-Port)) (define -Output-Port (make-Base 'Output-Port #'output-port? output-port? #'-Output-Port))
(define -Input-Port (make-Base 'Input-Port #'input-port? input-port? #'-Input-Port)) (define -Input-Port (make-Base 'Input-Port #'input-port? input-port? #'-Input-Port))
@ -159,8 +163,11 @@
(define -Port (*Un -Output-Port -Input-Port)) (define -Port (*Un -Output-Port -Input-Port))
(define -SomeSystemPath (*Un -Path -OtherSystemPath))
(define -Pathlike (*Un -String -Path)) (define -Pathlike (*Un -String -Path))
(define -Pathlike* (*Un -String -Path (-val 'up) (-val 'same))) (define -SomeSystemPathlike (*Un -String -SomeSystemPath))
;(define -Pathlike* (*Un -String -Path (-val 'up) (-val 'same)))
(define -SomeSystemPathlike* (*Un -String -SomeSystemPath(-val 'up) (-val 'same)))
(define -Pattern (*Un -Bytes -Regexp -PRegexp -Byte-Regexp -Byte-PRegexp -String)) (define -Pattern (*Un -Bytes -Regexp -PRegexp -Byte-Regexp -Byte-PRegexp -String))
(define -top (make-Top)) (define -top (make-Top))