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

Use regular define for `open-input-file' and friends.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2011-08-13 16:09:15 -04:00
parent 5f29dcdc23
commit 25084de5a7
2 changed files with 102 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

208
collects/racket/private/kw-file.rkt
View File

@ -1,13 +1,15 @@
(module kw-file "pre-base.rkt"
(provide -open-input-file
-open-output-file
-open-input-output-file
-call-with-input-file
-call-with-output-file
-with-input-from-file
-with-output-to-file
(require (prefix-in k: "pre-base.rkt"))
(provide (rename-out
[open-input-file -open-input-file]
[open-output-file -open-output-file]
[open-input-output-file -open-input-output-file]
[call-with-input-file -call-with-input-file]
[call-with-output-file -call-with-output-file]
[with-input-from-file -with-input-from-file]
[with-output-to-file -with-output-to-file])
call-with-input-file*
call-with-output-file*)
@ -17,114 +19,98 @@
(define exists-desc
"'error, 'append, 'update, 'can-update, 'replace, 'truncate, 'must-truncate, or 'truncate/replace")
(define -open-input-file
(let ([open-input-file (lambda (path #:mode [mode 'binary])
(unless (path-string? path)
(raise-type-error 'open-input-file "path or string" path))
(unless (memq mode '(binary text))
(raise-type-error 'open-input-file "'binary or 'text" mode))
(open-input-file path mode))])
open-input-file))
(define (open-input-file path #:mode [mode 'binary])
(unless (path-string? path)
(raise-type-error 'open-input-file "path or string" path))
(unless (memq mode '(binary text))
(raise-type-error 'open-input-file "'binary or 'text" mode))
(k:open-input-file path mode))
(define -open-output-file
(let ([open-output-file (lambda (path #:mode [mode 'binary]
#:exists [exists 'error])
(unless (path-string? path)
(raise-type-error 'open-output-file "path or string" path))
(unless (memq mode '(binary text))
(raise-type-error 'open-output-file "'binary or 'text" mode))
(unless (memq exists exists-syms)
(raise-type-error 'open-output-file exists-desc exists))
(open-output-file path mode exists))])
open-output-file))
(define (open-output-file path #:mode [mode 'binary]
#:exists [exists 'error])
(unless (path-string? path)
(raise-type-error 'open-output-file "path or string" path))
(unless (memq mode '(binary text))
(raise-type-error 'open-output-file "'binary or 'text" mode))
(unless (memq exists exists-syms)
(raise-type-error 'open-output-file exists-desc exists))
(k:open-output-file path mode exists))
(define -open-input-output-file
(let ([open-input-output-file (lambda (path #:mode [mode 'binary]
#:exists [exists 'error])
(unless (path-string? path)
(raise-type-error 'open-input-output-file "path or string" path))
(unless (memq mode '(binary text))
(raise-type-error 'open-input-output-file "'binary or 'text" mode))
(unless (memq exists exists-syms)
(raise-type-error 'open-input-output-file exists-desc exists))
(open-input-output-file path mode exists))])
open-input-output-file))
(define (open-input-output-file path #:mode [mode 'binary]
#:exists [exists 'error])
(unless (path-string? path)
(raise-type-error 'open-input-output-file "path or string" path))
(unless (memq mode '(binary text))
(raise-type-error 'open-input-output-file "'binary or 'text" mode))
(unless (memq exists exists-syms)
(raise-type-error 'open-input-output-file exists-desc exists))
(k:open-input-output-file path mode exists))
(define -call-with-input-file
(let ([call-with-input-file (lambda (path proc #:mode [mode 'binary])
(unless (path-string? path)
(raise-type-error 'call-with-input-file "path or string" path))
(unless (and (procedure? proc)
(procedure-arity-includes? proc 1))
(raise-type-error 'call-with-input-file "procedure (arity 1)" proc))
(unless (memq mode '(binary text))
(raise-type-error 'call-with-input-file "'binary or 'text" mode))
(call-with-input-file path proc mode))])
call-with-input-file))
(define (call-with-input-file path proc #:mode [mode 'binary])
(unless (path-string? path)
(raise-type-error 'call-with-input-file "path or string" path))
(unless (and (procedure? proc)
(procedure-arity-includes? proc 1))
(raise-type-error 'call-with-input-file "procedure (arity 1)" proc))
(unless (memq mode '(binary text))
(raise-type-error 'call-with-input-file "'binary or 'text" mode))
(k:call-with-input-file path proc mode))
(define -call-with-output-file
(let ([call-with-output-file (lambda (path proc
#:mode [mode 'binary]
#:exists [exists 'error])
(unless (path-string? path)
(raise-type-error 'call-with-output-file "path or string" path))
(unless (and (procedure? proc)
(procedure-arity-includes? proc 1))
(raise-type-error 'call-with-output-file "procedure (arity 1)" proc))
(unless (memq mode '(binary text))
(raise-type-error 'call-with-output-file "'binary or 'text" mode))
(unless (memq exists exists-syms)
(raise-type-error 'call-with-output-file exists-desc exists))
(call-with-output-file path proc mode exists))])
call-with-output-file))
(define -with-input-from-file
(let ([with-input-from-file (lambda (path proc #:mode [mode 'binary])
(unless (path-string? path)
(raise-type-error 'with-input-from-file "path or string" path))
(unless (and (procedure? proc)
(procedure-arity-includes? proc 0))
(raise-type-error 'with-input-from-file "procedure (arity 0)" proc))
(unless (memq mode '(binary text))
(raise-type-error 'with-input-from-file "'binary or 'text" mode))
(with-input-from-file path proc mode))])
with-input-from-file))
(define (call-with-output-file path proc
#:mode [mode 'binary]
#:exists [exists 'error])
(unless (path-string? path)
(raise-type-error 'call-with-output-file "path or string" path))
(unless (and (procedure? proc)
(procedure-arity-includes? proc 1))
(raise-type-error 'call-with-output-file "procedure (arity 1)" proc))
(unless (memq mode '(binary text))
(raise-type-error 'call-with-output-file "'binary or 'text" mode))
(unless (memq exists exists-syms)
(raise-type-error 'call-with-output-file exists-desc exists))
(k:call-with-output-file path proc mode exists))
(define -with-output-to-file
(let ([with-output-to-file (lambda (path proc
#:mode [mode 'binary]
#:exists [exists 'error])
(unless (path-string? path)
(raise-type-error 'with-output-to-file "path or string" path))
(unless (and (procedure? proc)
(procedure-arity-includes? proc 0))
(raise-type-error 'with-output-to-file "procedure (arity 0)" proc))
(unless (memq mode '(binary text))
(raise-type-error 'with-output-to-file "'binary or 'text" mode))
(unless (memq exists exists-syms)
(raise-type-error 'with-output-to-file exists-desc exists))
(with-output-to-file path proc mode exists))])
with-output-to-file))
(define (with-input-from-file path proc #:mode [mode 'binary])
(unless (path-string? path)
(raise-type-error 'with-input-from-file "path or string" path))
(unless (and (procedure? proc)
(procedure-arity-includes? proc 0))
(raise-type-error 'with-input-from-file "procedure (arity 0)" proc))
(unless (memq mode '(binary text))
(raise-type-error 'with-input-from-file "'binary or 'text" mode))
(k:with-input-from-file path proc mode))
(define call-with-input-file*
(lambda (path proc #:mode [mode 'binary])
(unless (path-string? path)
(raise-type-error 'call-with-input-file* "path or string" path))
(unless (and (procedure? proc)
(procedure-arity-includes? proc 1))
(raise-type-error 'call-with-input-file* "procedure (arity 1)" proc))
(unless (memq mode '(binary text))
(raise-type-error 'call-with-input-file* "'binary or 'text" mode))
(let ([p (open-input-file path mode)])
(dynamic-wind
void
(lambda () (proc p))
(lambda () (close-input-port p))))))
(define (with-output-to-file path proc
#:mode [mode 'binary]
#:exists [exists 'error])
(unless (path-string? path)
(raise-type-error 'with-output-to-file "path or string" path))
(unless (and (procedure? proc)
(procedure-arity-includes? proc 0))
(raise-type-error 'with-output-to-file "procedure (arity 0)" proc))
(unless (memq mode '(binary text))
(raise-type-error 'with-output-to-file "'binary or 'text" mode))
(unless (memq exists exists-syms)
(raise-type-error 'with-output-to-file exists-desc exists))
(k:with-output-to-file path proc mode exists))
(define call-with-output-file*
(lambda (path proc
#:mode [mode 'binary]
#:exists [exists 'error])
(define (call-with-input-file* path proc #:mode [mode 'binary])
(unless (path-string? path)
(raise-type-error 'call-with-input-file* "path or string" path))
(unless (and (procedure? proc)
(procedure-arity-includes? proc 1))
(raise-type-error 'call-with-input-file* "procedure (arity 1)" proc))
(unless (memq mode '(binary text))
(raise-type-error 'call-with-input-file* "'binary or 'text" mode))
(let ([p (k:open-input-file path mode)])
(dynamic-wind
void
(lambda () (proc p))
(lambda () (close-input-port p)))))
(define (call-with-output-file* path proc
#:mode [mode 'binary]
#:exists [exists 'error])
(unless (path-string? path)
(raise-type-error 'call-with-output-file* "path or string" path))
(unless (and (procedure? proc)
@ -134,8 +120,8 @@
(raise-type-error 'call-with-output-file* "'binary or 'text" mode))
(unless (memq exists exists-syms)
(raise-type-error 'call-with-output-file* exists-desc exists))
(let ([p (open-output-file path mode exists)])
(let ([p (k:open-output-file path mode exists)])
(dynamic-wind
void
(lambda () (proc p))
(lambda () (close-output-port p)))))))
(lambda () (close-output-port p))))))

5
collects/tests/racket/file.rktl
View File

@ -131,6 +131,11 @@
(test "12\r3" read (open-input-string (string #\" #\1 #\\ #\return #\newline #\2 #\\ #\newline #\return #\3 #\")))
(test "1\r23" read (open-input-string (string #\" #\1 #\\ #\newline #\return #\2 #\\ #\return #\newline #\3 #\")))
;; test names of file handling procedures (see racket/private/kw-file)
(test 'open-input-file object-name open-input-file)
(test 'with-input-from-file object-name with-input-from-file)
(test 'call-with-output-file object-name call-with-output-file)
; Test string ports with file-position:
(let ([s (open-output-string)])
(test (string) get-output-string s)