From 534d89b983a2c2c81f20cabf68b7c9ed7f930ec8 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Tue, 30 Aug 2011 10:43:54 -0400 Subject: [PATCH] Fix type of `make-temporary-file'. --- .../special-env-typecheck-tests.rkt | 6 ++ .../unit-tests/typecheck-tests.rkt | 5 -- collects/typed-scheme/base-env/base-env.rkt | 86 +------------------ .../base-env/base-special-env.rkt | 6 +- 4 files changed, 12 insertions(+), 91 deletions(-) diff --git a/collects/tests/typed-scheme/unit-tests/special-env-typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/special-env-typecheck-tests.rkt index ff0d1af2c2..f8a639a7e5 100644 --- a/collects/tests/typed-scheme/unit-tests/special-env-typecheck-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/special-env-typecheck-tests.rkt @@ -113,6 +113,12 @@ [tc-e (with-handlers ([void (λ (x) (values 0 0))]) (values "" "")) #:ret (ret (list (t:Un -Zero -String) (t:Un -Zero -String)))] + (tc-e (make-temporary-file) -Path) + (tc-e (make-temporary-file "ee~a") -Path) + (tc-e (make-temporary-file "ee~a" 'directory) -Path) + (tc-e (make-temporary-file "ee~a" "temp" "here") -Path) + + )) diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt index 5c6cb4be16..4a2d805ef6 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt @@ -1096,11 +1096,6 @@ (tc-e (make-directory* "tmp/a/b/c") -Void) - (tc-e (make-temporary-file) -Path) - (tc-e (make-temporary-file "ee~a") -Path) - (tc-e (make-temporary-file "ee~a" 'directory) -Path) - (tc-e (make-temporary-file "ee~a" "temp" "here") -Path) - (tc-e (put-preferences (list 'sym 'sym2) (list 'v1 'v2)) -Void) diff --git a/collects/typed-scheme/base-env/base-env.rkt b/collects/typed-scheme/base-env/base-env.rkt index 5b1d921730..42efb05ade 100644 --- a/collects/typed-scheme/base-env/base-env.rkt +++ b/collects/typed-scheme/base-env/base-env.rkt @@ -738,43 +738,6 @@ ;Section 14.2.5 ;racket/file -#| -[file->string (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -String)] -[file->bytes (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -Bytes)] -[file->value (->key -Pathlike #:mode (one-of/c 'binary 'text) #f Univ)] -[file->list - (-poly (a) - (cl->* (->key -Pathlike #:mode (one-of/c 'binary 'text) #f (-lst Univ)) - (->key -Pathlike (-> -Input-Port a) #:mode (one-of/c 'binary 'text) #f (-lst a))))] - -[file->lines - (->key -Pathlike #:mode (one-of/c 'binary 'text) #f - #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f - (-lst -String))] -[file->bytes-lines - (->key -Pathlike #:mode (one-of/c 'binary 'text) #f - #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f - (-lst -Bytes))] - -[display-to-file - (->key Univ -Pathlike - #:mode (one-of/c 'binary 'text) #f - #:exists (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) #f - -Void)] -[write-to-file - (->key Univ -Pathlike - #:mode (one-of/c 'binary 'text) #f - #:exists (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) #f - -Void)] - -[display-lines-to-file - (->key (-lst Univ) -Pathlike - #:separator Univ #f - #:mode (one-of/c 'binary 'text) #f - #:exists (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) #f - -Void)] -|# - [copy-directory/files (-> -Pathlike -Pathlike -Void)] [delete-directory/files (-> -Pathlike -Void)] @@ -789,59 +752,12 @@ ((Un funarg funarg*) a [(-opt -Pathlike) Univ]. ->opt . a)))] [make-directory* (-> -Pathlike -Void)] -[make-temporary-file (->opt [-String (Un -Pathlike (-val 'directory) (-val #f)) (-opt -Pathlike)] -Path)] +#;[make-temporary-file (->opt [-String (Un -Pathlike (-val 'directory) (-val #f)) (-opt -Pathlike)] -Path)] -#| -[get-preference - (let ((use-lock-type Univ) - (timeout-lock-there-type (-opt (-> -Path Univ))) - (lock-there-type (-opt (-> -Path Univ)))) - (cl->* - (->key Sym - #:use-lock? use-lock-type #f #:timeout-lock-there timeout-lock-there-type #f #:lock-there lock-there-type #f - Univ) - (->key Sym (-> Univ) - #:use-lock? use-lock-type #f #:timeout-lock-there timeout-lock-there-type #f #:lock-there lock-there-type #f - Univ) - (->key Sym (-> Univ) Univ - #:use-lock? use-lock-type #f #:timeout-lock-there timeout-lock-there-type #f #:lock-there lock-there-type #f - Univ) - (->key Sym (-> Univ) Univ (-opt -Pathlike) - #:use-lock? use-lock-type #f #:timeout-lock-there timeout-lock-there-type #f #:lock-there lock-there-type #f - Univ)))] -|# [put-preferences (->opt (-lst -Symbol) (-lst Univ) [(-> -Path Univ) (-opt -Pathlike)] -Void)] [preferences-lock-file-mode (-> (one-of/c 'exists 'file-lock))] -#| -[make-handle-get-preference-locked - (let ((lock-there-type (-opt (-> -Path Univ))) (max-delay-type -Real)) - (cl->* - (->key -Real Sym - #:lock-there lock-there-type #f #:max-delay max-delay-type #f - (-> -Pathlike Univ)) - (->key -Real Sym (-> Univ) - #:lock-there lock-there-type #f #:max-delay max-delay-type #f - (-> -Pathlike Univ)) - (->key -Real Sym (-> Univ) Univ - #:lock-there lock-there-type #f #:max-delay max-delay-type #f - (-> -Pathlike Univ)) - (->key -Real Sym (-> Univ) Univ (-opt -Pathlike) - #:lock-there lock-there-type #f #:max-delay max-delay-type #f - (-> -Pathlike Univ))))] - -[call-with-file-lock/timeout - (-poly (a) - (->key (-opt -Pathlike) - (one-of/c 'shared 'exclusive) - (-> a) - (-> a) - #:lock-file (-opt -Pathlike) #f - #:delay -Real #f - #:max-delay -Real #f - a))] -|# [make-lock-file-name (->opt -Pathlike [-Pathlike] -Pathlike)] diff --git a/collects/typed-scheme/base-env/base-special-env.rkt b/collects/typed-scheme/base-env/base-special-env.rkt index 17b1e2e67f..feca7b9e6a 100644 --- a/collects/typed-scheme/base-env/base-special-env.rkt +++ b/collects/typed-scheme/base-env/base-special-env.rkt @@ -32,7 +32,7 @@ #:context #'make-promise [(_ mp . _) #'mp]) (-poly (a) (-> (-> a) (-Promise a)))] - + ;; language [(syntax-parse (local-expand #'(this-language) 'expression null) #:context #'language @@ -185,6 +185,10 @@ #'with-syntax-fail]) (-> (-Syntax Univ) (Un))] + + [(local-expand #'make-temporary-file 'expression #f) + (->opt [-String (Un -Pathlike (-val 'directory) (-val #f)) (-opt -Pathlike)] -Path)] + ;; below here: keyword-argument functions from the base environment ;; FIXME: abstraction to remove duplication here #:middle