* 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:
Abdulaziz Ghuloum 2006-12-21 10:56:07 +03:00
parent f7aa4c99e1
commit 2fcae826d1
4 changed files with 36 additions and 44 deletions

1
TODO
View File

@ -1,4 +1,5 @@
* Guardians:
CHECK - Implement guardians.
- clean up after file ports are dead by flushing/closing the
underlying file handle.

Binary file not shown.

View File

@ -679,16 +679,15 @@
(error 'with-output-to-file "~s is not a procedure" proc))
(let ([p (apply open-output-file name args)]
[shot #f])
(parameterize ([current-output-port p])
(dynamic-wind
(lambda ()
(when shot
(error 'with-output-to-file
"cannot reenter")))
proc
(lambda ()
(close-output-port p)
(set! shot #t)))))))
(call-with-values
(lambda ()
(parameterize ([current-output-port p])
(proc)))
(case-lambda
[(v) (close-output-port p) v]
[v*
(close-output-port p)
(apply values v*)])))))
(primitive-set! 'call-with-output-file
(lambda (name proc . args)
@ -696,16 +695,13 @@
(error 'call-with-output-file "~s is not a string" name))
(unless (procedure? proc)
(error 'call-with-output-file "~s is not a procedure" proc))
(let ([p (apply open-output-file name args)]
[shot #f])
(dynamic-wind
(lambda ()
(when shot
(error 'call-with-output-file "cannot reenter")))
(lambda () (proc p))
(lambda ()
(close-output-port p)
(set! shot #t))))))
(let ([p (apply open-output-file name args)])
(call-with-values (lambda () (proc p))
(case-lambda
[(v) (close-output-port p) v]
[v*
(close-output-port p)
(apply values v*)])))))
(primitive-set! 'with-input-from-file
(lambda (name proc)
@ -713,33 +709,28 @@
(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)]
[shot #f])
(parameterize ([current-input-port p])
(dynamic-wind
(lambda ()
(when shot
(error 'with-input-from-file
"cannot reenter")))
proc
(lambda ()
(close-input-port p)
(set! shot #t)))))))
(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)]
[shot #f])
(dynamic-wind
(lambda ()
(when shot
(error 'call-with-input-file "cannot reenter")))
(lambda () (proc p))
(lambda ()
(close-input-port p)
(set! shot #t))))))
(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*)])))))
)

View File

@ -83,7 +83,7 @@
file-exists? delete-file + - add1 sub1 * expt
quotient+remainder quotient remainder number? positive?
negative? zero? number->string logand = < > <= >=
make-guardian
make-guardian weak-cons
))
(define system-primitives