Update extras

1 files changed, 50 insertions, 8 deletions

@@ -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)