diff --git a/libguile/strports.c b/libguile/strports.c index c8cce354e..7b51a8c87 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -354,35 +354,27 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0, - (SCM proc), - "Calls the one-argument procedure @var{proc} with a newly created output\n" - "port. When the function returns, the string composed of the characters\n" - "written into the port is returned.") -#define FUNC_NAME s_scm_call_with_output_string +SCM +scm_call_with_output_string (SCM proc) { - SCM p; + static SCM var = SCM_BOOL_F; - p = scm_mkstrport (SCM_INUM0, SCM_BOOL_F, - SCM_OPN | SCM_WRTNG, - FUNC_NAME); - scm_call_1 (proc, p); + if (scm_is_false (var)) + var = scm_c_private_lookup ("guile", "call-with-output-string"); - return scm_get_output_string (p); + return scm_call_1 (scm_variable_ref (var), proc); } -#undef FUNC_NAME -SCM_DEFINE (scm_call_with_input_string, "call-with-input-string", 2, 0, 0, - (SCM string, SCM proc), - "Calls the one-argument procedure @var{proc} with a newly\n" - "created input port from which @var{string}'s contents may be\n" - "read. The value yielded by the @var{proc} is returned.") -#define FUNC_NAME s_scm_call_with_input_string +SCM +scm_call_with_input_string (SCM string, SCM proc) { - SCM p = scm_mkstrport(SCM_INUM0, string, SCM_OPN | SCM_RDNG, FUNC_NAME); - return scm_call_1 (proc, p); + static SCM var = SCM_BOOL_F; + + if (scm_is_false (var)) + var = scm_c_private_lookup ("guile", "call-with-input-string"); + + return scm_call_2 (scm_variable_ref (var), string, proc); } -#undef FUNC_NAME SCM_DEFINE (scm_open_input_string, "open-input-string", 1, 0, 0, (SCM str), diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 8fbddd07e..1630461e1 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -1456,6 +1456,12 @@ procedures, their behavior is implementation dependent." (call-with-output-file file (lambda (p) (with-error-to-port p thunk)))) +(define (call-with-input-string string proc) + "Calls the one-argument procedure @var{proc} with a newly created +input port from which @var{string}'s contents may be read. The value +yielded by the @var{proc} is returned." + (proc (open-input-string string))) + (define (with-input-from-string string thunk) "THUNK must be a procedure of no arguments. The test of STRING is opened for @@ -1468,6 +1474,14 @@ procedures, their behavior is implementation dependent." (call-with-input-string string (lambda (p) (with-input-from-port p thunk)))) +(define (call-with-output-string proc) + "Calls the one-argument procedure @var{proc} with a newly created output +port. When the function returns, the string composed of the characters +written into the port is returned." + (let ((port (open-output-string))) + (proc port) + (get-output-string port))) + (define (with-output-to-string thunk) "Calls THUNK and returns its output as a string." (call-with-output-string