* moved call-with-input-file and with-input-from-file to
ikarus.io.input-files
This commit is contained in:
parent
e33b2a29e3
commit
459a0500b7
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -1,6 +1,7 @@
|
|||
|
||||
(library (ikarus io input-files)
|
||||
(export open-input-file current-input-port console-input-port)
|
||||
(export open-input-file current-input-port console-input-port
|
||||
with-input-from-file call-with-input-file)
|
||||
(import
|
||||
(only (scheme) $set-port-input-size! $set-port-input-index!
|
||||
$string-ref $string-set! $port-input-buffer $port-input-size
|
||||
|
@ -8,6 +9,7 @@
|
|||
$fx= $fx< $fx> $fx>= $fxadd1 $fxsub1)
|
||||
(except (ikarus)
|
||||
open-input-file current-input-port console-input-port
|
||||
with-input-from-file call-with-input-file
|
||||
*standard-input-port* *current-input-port*))
|
||||
|
||||
(define-syntax message-case
|
||||
|
@ -134,6 +136,37 @@
|
|||
($open-input-file filename)
|
||||
(error 'open-input-file "~s is not a string" filename))))
|
||||
|
||||
(define with-input-from-file
|
||||
(lambda (name proc)
|
||||
(unless (string? name)
|
||||
(error 'with-input-from-file "~s is not a string" name))
|
||||
(unless (procedure? proc)
|
||||
(error 'with-input-from-file "~s is not a procedure" proc))
|
||||
(let ([p ($open-input-file name)])
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(parameterize ([current-input-port p])
|
||||
(proc)))
|
||||
(case-lambda
|
||||
[(v) (close-input-port p) v]
|
||||
[v*
|
||||
(close-input-port p)
|
||||
(apply values v*)])))))
|
||||
|
||||
(define call-with-input-file
|
||||
(lambda (name proc)
|
||||
(unless (string? name)
|
||||
(error 'call-with-input-file "~s is not a string" name))
|
||||
(unless (procedure? proc)
|
||||
(error 'call-with-input-file "~s is not a procedure" proc))
|
||||
(let ([p ($open-input-file name)])
|
||||
(call-with-values (lambda () (proc p))
|
||||
(case-lambda
|
||||
[(v) (close-input-port p) v]
|
||||
[v*
|
||||
(close-input-port p)
|
||||
(apply values v*)])))))
|
||||
|
||||
(define *standard-input-port* #f)
|
||||
(define *current-input-port* #f)
|
||||
|
||||
|
|
|
@ -123,37 +123,6 @@
|
|||
(get-output-string p))))
|
||||
|
||||
|
||||
|
||||
(primitive-set! 'with-input-from-file
|
||||
(lambda (name proc)
|
||||
(unless (string? name)
|
||||
(error 'with-input-from-file "~s is not a string" name))
|
||||
(unless (procedure? proc)
|
||||
(error 'with-input-from-file "~s is not a procedure" proc))
|
||||
(let ([p (open-input-file name)])
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(parameterize ([current-input-port p])
|
||||
(proc)))
|
||||
(case-lambda
|
||||
[(v) (close-input-port p) v]
|
||||
[v*
|
||||
(close-input-port p)
|
||||
(apply values v*)])))))
|
||||
|
||||
(primitive-set! 'call-with-input-file
|
||||
(lambda (name proc)
|
||||
(unless (string? name)
|
||||
(error 'call-with-input-file "~s is not a string" name))
|
||||
(unless (procedure? proc)
|
||||
(error 'call-with-input-file "~s is not a procedure" proc))
|
||||
(let ([p (open-input-file name)])
|
||||
(call-with-values (lambda () (proc p))
|
||||
(case-lambda
|
||||
[(v) (close-input-port p) v]
|
||||
[v*
|
||||
(close-input-port p)
|
||||
(apply values v*)])))))
|
||||
)
|
||||
)
|
||||
|
||||
)
|
||||
|
|
Loading…
Reference in New Issue