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

---
 Makefile             | 36 +++++++++++++++++++++++++++++-------
 chicanery.extras.scm | 46 +++++++++++++++++++++++++++++++---------------
 2 files changed, 60 insertions(+), 22 deletions(-)

diff --git a/Makefile b/Makefile
index 38d0ce0..5c1c8b3 100644
--- a/Makefile
+++ b/Makefile
@@ -1,13 +1,35 @@
 # chicanery
 ## this makefile exists only to ... make ... cleaning up easier, really.
 
-.PHONY: build install clean
+NAME = chicanery
 
-build:
-	chicken-install -n
-
-install:
-	chicken-install
+default:
+	@echo "CHICANERY: subtly breaking scheme expectations"
+	@echo "Use R7RS and all of R7RS.  The following schemes are supported:"
+	@sed -n 's/^\([^.].*\): *supported.*/- \1/p' Makefile
 
+.PHONY: clean
 clean:
-	rm -f *.sh *.import.* *.inline *.link *.o *.so *.types
+	rm -f $(NAME) *.sh *.import.* *.inline *.link *.o* *.so *.types
+
+# Scheme implementation demoes
+
+.PHONY: supported
+supported:
+
+.PHONY: chicken
+chicken: supported chicanery.egg
+	csi -R chicanery
+
+.PHONY: guile
+guile: supported
+	echo '(import (chicanery))' > /tmp/chicanery.guile-bootstrap
+	guile -L . -l /tmp/chicanery.guile-bootstrap
+
+.PHONY: gambit
+gambit: supported chicanery\#.scm
+	gsi . -e '(import (chicanery))' -
+
+.PHONY: chibi
+chibi: supported
+	chibi-scheme -I. -mchicanery
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