From cd90c50267ad3cee1340d891759c5330af566e3d Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Tue, 8 Aug 2023 23:41:40 -0500
Subject: Support multiple schemes

---
 chicanery.extras.scm | 46 +++++++++++++++++++++++++++++++---------------
 1 file changed, 31 insertions(+), 15 deletions(-)

(limited to 'chicanery.extras.scm')

diff --git a/chicanery.extras.scm b/chicanery.extras.scm
index 27968df..bbd044f 100644
--- a/chicanery.extras.scm
+++ b/chicanery.extras.scm
@@ -1,15 +1,11 @@
 ;;; chicanery extras --- extra stuff from ur old pal acdw
 
-(export list-map
-        list-for-each
-        list-append)
-
 ;;; Generalized map, for-each, ...
 ;; List versions are renamed `list-<function>'.  Un-prefixed versions work
 ;; with any (default) datatype.  TODO: generalize?
-(define list-map map)
-(define list-for-each for-each)
-(define list-append append)
+(define list-map scheme/map)
+(define list-for-each scheme/for-each)
+(define list-append scheme/append)
 
 (define (map proc . collections)
   (let ((first (car collections)))    ; we only need to check the first one
@@ -46,9 +42,6 @@
       (apply bytevector-append collections))
      (else (error "Bad datatype" first)))))
 
-(export ref
-        copy)
-
 ;;; Extended generic functions.
 ;; These functions already have a list- version defined, but no non-prefixed
 ;; one.  So I'm fixing that.
@@ -78,13 +71,9 @@
     (bytevector-copy collection))
    (else (error "Bad datatype" collection))))
 
-;;; Functions that should be in scheme
+;;; Definitions that should be in scheme
 ;; This sections should be as small as possible
 
-(export atom?
-        read-port
-        read-port-chunk-size)
-
 (define (atom? x)
   (not (pair? x)))
 
@@ -113,3 +102,30 @@
   (case-lambda
     (() (%read-port (current-input-port)))
     ((p) (%read-port p))))
+
+(define (defined? sym)
+  (call-with-current-continuation
+   (lambda (k)
+     (with-exception-handler
+         (lambda (e) (k #f))
+       (lambda ()
+         (eval sym (interaction-environment))
+         #t)))))
+
+(define (displayed x)
+  (call-with-port (open-output-string)
+    (lambda (port)
+      (display x port)
+      (get-output-string port))))
+
+(define (written x)
+  (call-with-port (open-output-string)
+    (lambda (port)
+      (write x port)
+      (get-output-string port))))
+
+(define (print x)
+  (display x)
+  (newline))
+
+(define ->string displayed)
-- 
cgit 1.4.1-21-gabe81