mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

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

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2012-03-07 13:34:06 +01:00
parent 4df9e5eb0f
commit a62b5c3d54
2 changed files with 28 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

36
libguile/strports.c
View file

@ -354,35 +354,27 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0, SCM
(SCM proc), scm_call_with_output_string (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 p; static SCM var = SCM_BOOL_F;
p = scm_mkstrport (SCM_INUM0, SCM_BOOL_F, if (scm_is_false (var))
SCM_OPN | SCM_WRTNG, var = scm_c_private_lookup ("guile", "call-with-output-string");
FUNC_NAME);
scm_call_1 (proc, p);
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
(SCM string, SCM proc), scm_call_with_input_string (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 p = scm_mkstrport(SCM_INUM0, string, SCM_OPN | SCM_RDNG, FUNC_NAME); static SCM var = SCM_BOOL_F;
return scm_call_1 (proc, p);
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_DEFINE (scm_open_input_string, "open-input-string", 1, 0, 0,
(SCM str), (SCM str),

14
module/ice-9/boot-9.scm
View file

@ -1456,6 +1456,12 @@ procedures, their behavior is implementation dependent."
(call-with-output-file file (call-with-output-file file
(lambda (p) (with-error-to-port p thunk)))) (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) (define (with-input-from-string string thunk)
"THUNK must be a procedure of no arguments. "THUNK must be a procedure of no arguments.
The test of STRING is opened for The test of STRING is opened for
@ -1468,6 +1474,14 @@ procedures, their behavior is implementation dependent."
(call-with-input-string string (call-with-input-string string
(lambda (p) (with-input-from-port p thunk)))) (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) (define (with-output-to-string thunk)
"Calls THUNK and returns its output as a string." "Calls THUNK and returns its output as a string."
(call-with-output-string (call-with-output-string