conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* moved call-with-input-file and with-input-from-file to 

ikarus.io.input-files
This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 19:59:28 -04:00
parent e33b2a29e3
commit 459a0500b7
3 changed files with 35 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

35
src/ikarus.io.input-files.ss
View File

@ -1,6 +1,7 @@
(library (ikarus io input-files) (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 (import
(only (scheme) $set-port-input-size! $set-port-input-index! (only (scheme) $set-port-input-size! $set-port-input-index!
$string-ref $string-set! $port-input-buffer $port-input-size $string-ref $string-set! $port-input-buffer $port-input-size
@ -8,6 +9,7 @@
$fx= $fx< $fx> $fx>= $fxadd1 $fxsub1) $fx= $fx< $fx> $fx>= $fxadd1 $fxsub1)
(except (ikarus) (except (ikarus)
open-input-file current-input-port console-input-port open-input-file current-input-port console-input-port
with-input-from-file call-with-input-file
*standard-input-port* *current-input-port*)) *standard-input-port* *current-input-port*))
(define-syntax message-case (define-syntax message-case
@ -134,6 +136,37 @@
($open-input-file filename) ($open-input-file filename)
(error 'open-input-file "~s is not a string" 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 *standard-input-port* #f)
(define *current-input-port* #f) (define *current-input-port* #f)

33
src/libchezio.ss
View File

@ -123,37 +123,6 @@
(get-output-string p)))) (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*)])))))
)
) )