make macro generators, test on chibi. Currently broken in CHICKEN-5 due to a bug in compiled syntax-rules macros

1 files changed, 35 insertions, 0 deletions

diff --git a/lib/cuprate/rewriters/chicken.sld b/lib/cuprate/rewriters/chicken.sld
new file mode 100644
index 0000000..f92f998
--- /dev/null
+++ b/lib/cuprate/rewriters/chicken.sld
@@ -0,0 +1,35 @@
+(define-library (cuprate rewriters chicken)
+  (import (scheme base) (scheme write)
+          (chicken memory representation)
+          (chicken condition))
+  (export rewriters rewrite)
+  (begin
+    (define (default-on-pair pair)
+      (cons (rewrite (car pair))
+            (rewrite (cdr pair))))
+    (define (default-on-vector vec)
+      (vector-map rewrite vec))
+    (define (default-on-error error)
+      (cons 'error
+            (cons (error-object-message error)
+                  (error-object-irritants error))))
+    (define (default-on-condition cond)
+      (map rewrite (condition->list cond)))
+    (define (default-on-record rec)
+      `(record (name ,(rewrite (record-instance-type rec)))
+               (elements
+                ,(vector-map rewrite (record->vector rec)))))
+    (define rewriters
+      (make-parameter
+       `((,pair? . ,default-on-pair)
+         (,vector? . ,default-on-vector)
+         (,error-object? . ,default-on-error)
+         (,condition? . ,default-on-condition)
+         (,record-instance? . ,default-on-record))))
+    (define (rewrite obj)
+      (let loop ((rewriters (rewriters)))
+        (cond
+          ((null? rewriters) obj)
+          (((caar rewriters) obj) ((cdar rewriters) obj))
+          (else (loop (cdr rewriters))))))))
+