From 246ee2e48fa40b7534e294f219f99688a3c823eb Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Sun, 13 Aug 2023 22:59:29 -0500
Subject: Update extras

---
 chicanery.extras.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 50 insertions(+), 8 deletions(-)

(limited to 'chicanery.extras.scm')

diff --git a/chicanery.extras.scm b/chicanery.extras.scm
index 27968df..bcb4929 100644
--- a/chicanery.extras.scm
+++ b/chicanery.extras.scm
@@ -1,8 +1,7 @@
 ;;; chicanery extras --- extra stuff from ur old pal acdw
 
-(export list-map
-        list-for-each
-        list-append)
+(export list-map list-for-each list-append
+        map for-each append)
 
 ;;; Generalized map, for-each, ...
 ;; List versions are renamed `list-<function>'.  Un-prefixed versions work
@@ -81,13 +80,9 @@
 ;;; Functions that should be in scheme
 ;; This sections should be as small as possible
 
-(export atom?
-        read-port
+(export read-port
         read-port-chunk-size)
 
-(define (atom? x)
-  (not (pair? x)))
-
 (define read-port-chunk-size
   (make-parameter 512))
 
@@ -113,3 +108,50 @@
   (case-lambda
     (() (%read-port (current-input-port)))
     ((p) (%read-port p))))
+
+(export atom? defined?)
+
+(define (atom? x)
+  (not (or (null? x)
+           (pair? x))))
+
+(define (defined? sym)
+  (call-with-current-continuation
+   (lambda (k)
+     (with-exception-handler
+         (lambda (e) (k #f))
+       (lambda ()
+         (eval sym (interaction-environment))
+         #t)))))
+
+(export with-output-to-string
+        with-input-from-string)
+
+(define (with-output-to-string thunk)
+  (call-with-port (open-output-string)
+    (lambda (port)
+      (parameterize ((current-output-port port))
+        (thunk))
+      (get-output-string port))))
+
+(define (with-input-from-string s thunk)
+  (call-with-port (open-input-string s)
+    (lambda (port)
+      (parameterize ((current-input-port port))
+        (thunk)))))
+
+(export displayed ->string written print)
+
+(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)
+  (newline))
+
+(define ->string displayed)
-- 
cgit 1.4.1-21-gabe81