* with-input-from-file, call-with-input-file, with-output-to-file,
and call-with-output-file no longer use dynamic-wind to track if an exit continuation is invoked multiple times.
This commit is contained in:
parent
f7aa4c99e1
commit
2fcae826d1
1
TODO
1
TODO
|
@ -1,4 +1,5 @@
|
||||||
* Guardians:
|
* Guardians:
|
||||||
|
CHECK - Implement guardians.
|
||||||
- clean up after file ports are dead by flushing/closing the
|
- clean up after file ports are dead by flushing/closing the
|
||||||
underlying file handle.
|
underlying file handle.
|
||||||
|
|
||||||
|
|
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -679,16 +679,15 @@
|
||||||
(error 'with-output-to-file "~s is not a procedure" proc))
|
(error 'with-output-to-file "~s is not a procedure" proc))
|
||||||
(let ([p (apply open-output-file name args)]
|
(let ([p (apply open-output-file name args)]
|
||||||
[shot #f])
|
[shot #f])
|
||||||
|
(call-with-values
|
||||||
|
(lambda ()
|
||||||
(parameterize ([current-output-port p])
|
(parameterize ([current-output-port p])
|
||||||
(dynamic-wind
|
(proc)))
|
||||||
(lambda ()
|
(case-lambda
|
||||||
(when shot
|
[(v) (close-output-port p) v]
|
||||||
(error 'with-output-to-file
|
[v*
|
||||||
"cannot reenter")))
|
|
||||||
proc
|
|
||||||
(lambda ()
|
|
||||||
(close-output-port p)
|
(close-output-port p)
|
||||||
(set! shot #t)))))))
|
(apply values v*)])))))
|
||||||
|
|
||||||
(primitive-set! 'call-with-output-file
|
(primitive-set! 'call-with-output-file
|
||||||
(lambda (name proc . args)
|
(lambda (name proc . args)
|
||||||
|
@ -696,16 +695,13 @@
|
||||||
(error 'call-with-output-file "~s is not a string" name))
|
(error 'call-with-output-file "~s is not a string" name))
|
||||||
(unless (procedure? proc)
|
(unless (procedure? proc)
|
||||||
(error 'call-with-output-file "~s is not a procedure" proc))
|
(error 'call-with-output-file "~s is not a procedure" proc))
|
||||||
(let ([p (apply open-output-file name args)]
|
(let ([p (apply open-output-file name args)])
|
||||||
[shot #f])
|
(call-with-values (lambda () (proc p))
|
||||||
(dynamic-wind
|
(case-lambda
|
||||||
(lambda ()
|
[(v) (close-output-port p) v]
|
||||||
(when shot
|
[v*
|
||||||
(error 'call-with-output-file "cannot reenter")))
|
|
||||||
(lambda () (proc p))
|
|
||||||
(lambda ()
|
|
||||||
(close-output-port p)
|
(close-output-port p)
|
||||||
(set! shot #t))))))
|
(apply values v*)])))))
|
||||||
|
|
||||||
(primitive-set! 'with-input-from-file
|
(primitive-set! 'with-input-from-file
|
||||||
(lambda (name proc)
|
(lambda (name proc)
|
||||||
|
@ -713,18 +709,16 @@
|
||||||
(error 'with-input-from-file "~s is not a string" name))
|
(error 'with-input-from-file "~s is not a string" name))
|
||||||
(unless (procedure? proc)
|
(unless (procedure? proc)
|
||||||
(error 'with-input-from-file "~s is not a procedure" proc))
|
(error 'with-input-from-file "~s is not a procedure" proc))
|
||||||
(let ([p (open-input-file name)]
|
(let ([p (open-input-file name)])
|
||||||
[shot #f])
|
(call-with-values
|
||||||
|
(lambda ()
|
||||||
(parameterize ([current-input-port p])
|
(parameterize ([current-input-port p])
|
||||||
(dynamic-wind
|
(proc)))
|
||||||
(lambda ()
|
(case-lambda
|
||||||
(when shot
|
[(v) (close-input-port p) v]
|
||||||
(error 'with-input-from-file
|
[v*
|
||||||
"cannot reenter")))
|
|
||||||
proc
|
|
||||||
(lambda ()
|
|
||||||
(close-input-port p)
|
(close-input-port p)
|
||||||
(set! shot #t)))))))
|
(apply values v*)])))))
|
||||||
|
|
||||||
(primitive-set! 'call-with-input-file
|
(primitive-set! 'call-with-input-file
|
||||||
(lambda (name proc)
|
(lambda (name proc)
|
||||||
|
@ -732,14 +726,11 @@
|
||||||
(error 'call-with-input-file "~s is not a string" name))
|
(error 'call-with-input-file "~s is not a string" name))
|
||||||
(unless (procedure? proc)
|
(unless (procedure? proc)
|
||||||
(error 'call-with-input-file "~s is not a procedure" proc))
|
(error 'call-with-input-file "~s is not a procedure" proc))
|
||||||
(let ([p (open-input-file name)]
|
(let ([p (open-input-file name)])
|
||||||
[shot #f])
|
(call-with-values (lambda () (proc p))
|
||||||
(dynamic-wind
|
(case-lambda
|
||||||
(lambda ()
|
[(v) (close-input-port p) v]
|
||||||
(when shot
|
[v*
|
||||||
(error 'call-with-input-file "cannot reenter")))
|
|
||||||
(lambda () (proc p))
|
|
||||||
(lambda ()
|
|
||||||
(close-input-port p)
|
(close-input-port p)
|
||||||
(set! shot #t))))))
|
(apply values v*)])))))
|
||||||
)
|
)
|
||||||
|
|
|
@ -83,7 +83,7 @@
|
||||||
file-exists? delete-file + - add1 sub1 * expt
|
file-exists? delete-file + - add1 sub1 * expt
|
||||||
quotient+remainder quotient remainder number? positive?
|
quotient+remainder quotient remainder number? positive?
|
||||||
negative? zero? number->string logand = < > <= >=
|
negative? zero? number->string logand = < > <= >=
|
||||||
make-guardian
|
make-guardian weak-cons
|
||||||
))
|
))
|
||||||
|
|
||||||
(define system-primitives
|
(define system-primitives
|
||||||
|
|
Loading…
Reference in New Issue