From 14847f7800a477544df8ea16bf5fec1d9ceddea0 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 9 Aug 2023 22:00:31 -0500 Subject: Add with-{input-from,output-to}-string Inspired by CHICKEN --- README.md | 2 ++ chicanery.extras.scm | 21 +++++++++++++++------ chicanery.sld | 2 ++ 3 files changed, 19 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index c8b1fcd..c275ffb 100644 --- a/README.md +++ b/README.md @@ -34,6 +34,8 @@ Other extras include - `(read-port)`, `(read-port port)` reads a port until hitting end-of-file (IDK why this isn't in R7RS!), in chunks of `read-port-chunk-size` - `(defined? x)` returns whether the symbol `x` is bound to a variable +- `(with-input-from-string str thunk)` calls `thunk` with `str` bound as the current-input-port. +- `(with-output-to-string thunk)` calls `thunk` and returns a string of the output. - `(displayed x)`, `(->string x)` returns `x` as a string (via `display`) - `(written x)` returns `x` as a string (via `write`) - `(print x ...)` displays `x ...` followed by a newline diff --git a/chicanery.extras.scm b/chicanery.extras.scm index dac823f..f264424 100644 --- a/chicanery.extras.scm +++ b/chicanery.extras.scm @@ -113,17 +113,26 @@ (eval sym (interaction-environment)) #t))))) -(define (displayed x) +(define (with-output-to-string thunk) (call-with-port (open-output-string) (lambda (port) - (display x port) + (parameterize ((current-output-port port)) + (thunk)) (get-output-string port)))) -(define (written x) - (call-with-port (open-output-string) +(define (with-input-from-string s thunk) + (call-with-port (open-input-string s) (lambda (port) - (write x port) - (get-output-string port)))) + (parameterize ((current-input-port port)) + (thunk))))) + +(define (displayed x) + (with-output-to-string + (lambda () (display x)))) + +(define (written x) + (with-output-to-string + (lambda () (write x)))) (define (print . xs) (for-each display xs) diff --git a/chicanery.sld b/chicanery.sld index 7835e80..a38b1e5 100644 --- a/chicanery.sld +++ b/chicanery.sld @@ -382,6 +382,8 @@ read-port read-port-chunk-size defined? + with-output-to-string + with-input-from-string displayed ->string written print) -- cgit 1.4.1-21-gabe81