call-with-{input,output}-string implemented in scheme

* module/ice-9/boot-9.scm (call-with-input-string)
  (call-with-output-string): Implement in Scheme.

* libguile/strports.c (scm_call_with_output_string):
  (scm_call_with_input_string): Dispatch to Scheme.

2 files changed, 28 insertions, 22 deletions

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