summaryrefslogtreecommitdiff
path: root/src/geiser/geiser.ss
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-10-09 16:21:38 +0100
committerjao <jao@gnu.org>2022-10-09 16:21:38 +0100
commit2d8cd83c646272c7c4d8f27af0155424d8f183fb (patch)
treea41fc739d72776bdce8eb3ae197910088b98defa /src/geiser/geiser.ss
parenta70c47c557e17f26803aa2be3836745b36fed1a2 (diff)
downloadgeiser-chez-2d8cd83c646272c7c4d8f27af0155424d8f183fb.tar.gz
geiser-chez-2d8cd83c646272c7c4d8f27af0155424d8f183fb.tar.bz2
wee refactoring
Diffstat (limited to 'src/geiser/geiser.ss')
-rw-r--r--src/geiser/geiser.ss18
1 files changed, 9 insertions, 9 deletions
diff --git a/src/geiser/geiser.ss b/src/geiser/geiser.ss
index 960b71a..dae82c0 100644
--- a/src/geiser/geiser.ss
+++ b/src/geiser/geiser.ss
@@ -9,6 +9,12 @@
geiser:macroexpand)
(import (chezscheme))
+ (define-syntax as-string
+ (syntax-rules () ((_ b ...) (with-output-to-string (lambda () b ...)))))
+
+ (define (write-to-string x) (as-string (write x)))
+ (define (pretty-string x) (as-string (pretty-print x)))
+
(define (call-with-result thunk)
(let ((output-string (open-output-string)))
(write
@@ -20,17 +26,14 @@
(k `((result "")
(output . ,(get-output-string output-string))
(error (key . condition)
- (msg . ,(with-output-to-string
- (lambda () (display-condition e))))))))
+ (msg . ,(as-string (display-condition e)))))))
(lambda ()
(call-with-values
(lambda ()
(parameterize ((current-output-port output-string)) (thunk)))
(lambda result
- `((result ,(with-output-to-string
- (lambda ()
- (pretty-print
- (if (null? (cdr result)) (car result) result)))))
+ `((result ,(pretty-string
+ (if (null? (cdr result)) (car result) result)))
(output . ,(get-output-string output-string))))))))))
(newline)
(close-output-port output-string)))
@@ -71,9 +74,6 @@
(map write-to-string
(environment-symbols (interaction-environment))))))
- (define (write-to-string x)
- (with-output-to-string (lambda () (write x))))
-
(define (geiser:eval module form)
(call-with-result
(lambda () (if module (eval form (environment module)) (eval form)))))