Author: yamakenz
Date: Mon Aug 6 16:30:31 2007
New Revision: 4804
Modified:
sigscheme-trunk/NEWS
sigscheme-trunk/TODO
sigscheme-trunk/lib/sigscheme-init.scm
sigscheme-trunk/src/port.c
sigscheme-trunk/src/sigscheme.h
Log:
* call-with-input-file, call-with-output-file, with-input-from-file and
with-output-to-file are re-implemented in lib/sigscheme-init.scm. The
standard current ports handling on with-input-from-file and
with-output-to-file are now continuation-safe by dynamic-wind
* src/sigscheme.h
* src/port.c
- (scm_p_call_with_input_file, scm_p_call_with_output_file,
scm_p_with_input_from_file, scm_p_with_output_to_file): Removed
* lib/sigscheme-init.scm
- (call-with-input-file, call-with-output-file, with-input-from-file,
with-output-to-file): New procedure replaces corresponding C functions
* NEWS
- Update
Modified: sigscheme-trunk/NEWS
==============================================================================
--- sigscheme-trunk/NEWS (original)
+++ sigscheme-trunk/NEWS Mon Aug 6 16:30:31 2007
@@ -60,6 +60,11 @@
but 'dev' since it has a considerable bug (such as infinite loop on
test-srfi1-another.scm)
+ - call-with-input-file, call-with-output-file, with-input-from-file and
+ with-output-to-file are re-implemented in lib/sigscheme-init.scm. The
+ standard current ports handling on with-input-from-file and
+ with-output-to-file are now continuation-safe by dynamic-wind
+
* Fixes
- [CRITICAL] Fix unterminated string generation on singlebyte character codec
Modified: sigscheme-trunk/TODO
==============================================================================
--- sigscheme-trunk/TODO (original)
+++ sigscheme-trunk/TODO Mon Aug 6 16:30:31 2007
@@ -36,9 +36,6 @@
* Make Symbian OS and BREW support working (patches are welcome)
-* Introduce dynamic environment for internal use
- - Fix continuation-unsafe current-{input,output}-port handling with it
-
* Implement numbers other than integer
- Define SAL accessors considering SRFI-50 and other implementations
- Evaluate R6RS Arithmetic
Modified: sigscheme-trunk/lib/sigscheme-init.scm
==============================================================================
--- sigscheme-trunk/lib/sigscheme-init.scm (original)
+++ sigscheme-trunk/lib/sigscheme-init.scm Mon Aug 6 16:30:31 2007
@@ -1,5 +1,5 @@
;; Filename : sigscheme-init.scm
-;; About : Initialize file for SigScheme
+;; About : Initialization file for SigScheme
;;
;; Copyright (c) 2007 SigScheme Project <uim-en AT googlegroups.com>
;;
@@ -61,3 +61,57 @@
(lambda ()
(%%load file))))
%%load))
+
+;; R5RS
+(define call-with-input-file
+ (lambda (filename proc)
+ (let* ((port (open-input-file filename))
+ (res (proc port)))
+ (close-input-port port)
+ res)))
+
+;; R5RS
+(define call-with-output-file
+ (lambda (filename proc)
+ (let* ((port (open-output-file filename))
+ (res (proc port)))
+ (close-output-port port)
+ res)))
+
+;; R5RS
+(define with-input-from-file
+ (lambda (file thunk)
+ (let ((orig-port (current-input-port))
+ (thunk-port (current-input-port)))
+ (dynamic-wind
+ (lambda ()
+ (%%set-current-input-port! thunk-port))
+ (lambda ()
+ (let* ((port (open-input-file file))
+ (res (begin
+ (set! thunk-port port)
+ (%%set-current-input-port! thunk-port)
+ (thunk))))
+ (close-input-port port)
+ res))
+ (lambda ()
+ (%%set-current-input-port! orig-port))))))
+
+;; R5RS
+(define with-output-to-file
+ (lambda (file thunk)
+ (let ((orig-port (current-output-port))
+ (thunk-port (current-output-port)))
+ (dynamic-wind
+ (lambda ()
+ (%%set-current-output-port! thunk-port))
+ (lambda ()
+ (let* ((port (open-output-file file))
+ (res (begin
+ (set! thunk-port port)
+ (%%set-current-output-port! thunk-port)
+ (thunk))))
+ (close-output-port port)
+ res))
+ (lambda ()
+ (%%set-current-output-port! orig-port))))))
Modified: sigscheme-trunk/src/port.c
==============================================================================
--- sigscheme-trunk/src/port.c (original)
+++ sigscheme-trunk/src/port.c Mon Aug 6 16:30:31 2007
@@ -259,41 +259,8 @@
/*===========================================================================
R5RS : 6.6 Input and Output : 6.6.1 Ports
===========================================================================*/
-SCM_EXPORT ScmObj
-scm_p_call_with_input_file(ScmObj filepath, ScmObj proc)
-{
- ScmObj port, ret;
- DECLARE_FUNCTION("call-with-input-file", procedure_fixed_2);
-
- ENSURE_STRING(filepath);
- ENSURE_PROCEDURE(proc);
-
- port = scm_p_open_input_file(filepath);
-
- ret = scm_call(proc, LIST_1(port));
-
- scm_p_close_input_port(port);
-
- return ret;
-}
-
-SCM_EXPORT ScmObj
-scm_p_call_with_output_file(ScmObj filepath, ScmObj proc)
-{
- ScmObj port, ret;
- DECLARE_FUNCTION("call-with-output-file", procedure_fixed_2);
-
- ENSURE_STRING(filepath);
- ENSURE_PROCEDURE(proc);
-
- port = scm_p_open_output_file(filepath);
-
- ret = scm_call(proc, LIST_1(port));
-
- scm_p_close_output_port(port);
-
- return ret;
-}
+/* call-with-input-file, call-with-output-file, with-input-from-file and
+ * with-output-to-file are implemented in lib/sigscheme-init.scm */
SCM_EXPORT ScmObj
scm_p_input_portp(ScmObj port)
@@ -379,48 +346,6 @@
scm_err = newport;
return SCM_TRUE;
-}
-
-/* TODO: dynamic environment for scm_in (although R5RS does not require it) */
-SCM_EXPORT ScmObj
-scm_p_with_input_from_file(ScmObj filepath, ScmObj thunk)
-{
- ScmObj saved_port, ret;
- DECLARE_FUNCTION("with-input-from-file", procedure_fixed_2);
-
- ENSURE_STRING(filepath);
- ENSURE_PROCEDURE(thunk);
-
- saved_port = scm_in;
- scm_in = scm_p_open_input_file(filepath);
-
- ret = scm_call(thunk, SCM_NULL);
-
- scm_p_close_input_port(scm_in);
- scm_in = saved_port;
-
- return ret;
-}
-
-/* TODO: dynamic environment for scm_out (although R5RS does not require it) */
-SCM_EXPORT ScmObj
-scm_p_with_output_to_file(ScmObj filepath, ScmObj thunk)
-{
- ScmObj saved_port, ret;
- DECLARE_FUNCTION("with-output-to-file", procedure_fixed_2);
-
- ENSURE_STRING(filepath);
- ENSURE_PROCEDURE(thunk);
-
- saved_port = scm_out;
- scm_out = scm_p_open_output_file(filepath);
-
- ret = scm_call(thunk, SCM_NULL);
-
- scm_p_close_output_port(scm_out);
- scm_out = saved_port;
-
- return ret;
}
SCM_EXPORT ScmObj
Modified: sigscheme-trunk/src/sigscheme.h
==============================================================================
--- sigscheme-trunk/src/sigscheme.h (original)
+++ sigscheme-trunk/src/sigscheme.h Mon Aug 6 16:30:31 2007
@@ -1582,8 +1582,6 @@
SCM_EXPORT void scm_port_put_char(ScmObj port, scm_ichar_t ch);
SCM_EXPORT void scm_port_newline(ScmObj port);
SCM_EXPORT void scm_port_flush(ScmObj port);
-SCM_EXPORT ScmObj scm_p_call_with_input_file(ScmObj filepath, ScmObj proc);
-SCM_EXPORT ScmObj scm_p_call_with_output_file(ScmObj filepath, ScmObj proc);
SCM_EXPORT ScmObj scm_p_input_portp(ScmObj obj);
SCM_EXPORT ScmObj scm_p_output_portp(ScmObj obj);
SCM_EXPORT ScmObj scm_p_current_input_port(void);
@@ -1592,8 +1590,6 @@
SCM_EXPORT ScmObj scm_p_set_current_input_portx(ScmObj newport);
SCM_EXPORT ScmObj scm_p_set_current_output_portx(ScmObj newport);
SCM_EXPORT ScmObj scm_p_set_current_error_portx(ScmObj newport);
-SCM_EXPORT ScmObj scm_p_with_input_from_file(ScmObj filepath, ScmObj thunk);
-SCM_EXPORT ScmObj scm_p_with_output_to_file(ScmObj filepath, ScmObj thunk);
SCM_EXPORT ScmObj scm_p_open_input_file(ScmObj filepath);
SCM_EXPORT ScmObj scm_p_open_output_file(ScmObj filepath);
SCM_EXPORT ScmObj scm_p_close_input_port(ScmObj port);
