move rewriters to implementation file, make rewriter cycle-detecting

4 files changed, 0 insertions, 98 deletions

diff --git a/lib/cuprate/rewriters.sld b/lib/cuprate/rewriters.sld
deleted file mode 100644
index a375cc8..0000000
--- a/lib/cuprate/rewriters.sld
+++ /dev/null
@@ -1,7 +0,0 @@
-(define-library (cuprate rewriters)
-  (import (scheme base))
-  (export rewriters rewrite)
-  (cond-expand
-    (chicken-5 (import (cuprate rewriters chicken)))
-    (foment (import (cuprate rewriters foment)))
-    (else (import (cuprate rewriters r7rs)))))
\ No newline at end of file
diff --git a/lib/cuprate/rewriters/chicken.sld b/lib/cuprate/rewriters/chicken.sld
deleted file mode 100644
index f92f998..0000000
--- a/lib/cuprate/rewriters/chicken.sld
+++ /dev/null
@@ -1,35 +0,0 @@
-(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))))))))
-
diff --git a/lib/cuprate/rewriters/foment.sld b/lib/cuprate/rewriters/foment.sld
deleted file mode 100644
index 248e2ef..0000000
--- a/lib/cuprate/rewriters/foment.sld
+++ /dev/null
@@ -1,32 +0,0 @@
-(define-library (cuprate rewriters foment)
-  (import (scheme base)
-          (only (foment base)
-                error-object-type
-                error-object-who
-                error-object-kind))
-  (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)
-      (let ((msg (error-object-message error))
-            (irritants (error-object-irritants error)))
-        `(error (type ,(rewrite (error-object-type error)))
-                (who ,(rewrite (error-object-who error)))
-                (kind ,(rewrite (error-object-kind error)))
-                (msg ,(rewrite (error-object-message error)))
-                (irritants ,@(map rewrite (error-object-irritants error))))))
-    (define rewriters
-      (make-parameter `((,pair? . ,default-on-pair)
-                        (,vector? . ,default-on-vector)
-                        (,error-object? . ,default-on-error))))
-    (define (rewrite obj)
-      (let loop ((rewriters (rewriters)))
-        (cond
-          ((null? rewriters) obj)
-          (((caar rewriters) obj) ((cdar rewriters) obj))
-          (else (loop (cdr rewriters))))))))
-
diff --git a/lib/cuprate/rewriters/r7rs.sld b/lib/cuprate/rewriters/r7rs.sld
deleted file mode 100644
index b231f81..0000000
--- a/lib/cuprate/rewriters/r7rs.sld
+++ /dev/null
@@ -1,24 +0,0 @@
-(define-library (cuprate rewriters r7rs)
-  (import (scheme base))
-  (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)
-      (let ((msg (error-object-message error))
-            (irritants (error-object-irritants error)))
-        (cons 'error (cons msg irritants))))
-    (define rewriters
-      (make-parameter `((,pair? . ,default-on-pair)
-                        (,vector? . ,default-on-vector)
-                        (,error-object? . ,default-on-error))))
-    (define (rewrite obj)
-      (let loop ((rewriters (rewriters)))
-        (cond
-          ((null? rewriters) obj)
-          (((caar rewriters) obj) ((cdar rewriters) obj))
-          (else (loop (cdr rewriters))))))))
-