move rewriters to implementation file, make rewriter cycle-detecting

1 files changed, 15 insertions, 3 deletions

diff --git a/lib/cuprate/implementation/foment.sld b/lib/cuprate/implementation/foment.sld
index 2ad53dc..907decd 100644
--- a/lib/cuprate/implementation/foment.sld
+++ b/lib/cuprate/implementation/foment.sld
@@ -1,10 +1,22 @@
 (define-library (cuprate implementation foment)
-  (import (scheme base) (srfi 166) (srfi 225))
+  (import (foment base) (scheme base) (srfi 166) (srfi 225) (srfi 128) (srfi 125))
   (export pretty-print default-test-dto
-          alist->default-dictionary)
+          alist->default-dictionary
+          make-eq-map implementation-rewriters)
+  (include "srfi-125-eq-map.scm")
   (begin
     (define (pretty-print obj)
       (show #t (pretty obj))
       (newline))
     (define default-test-dto eqv-alist-dto)
-    (define (alist->default-dictionary x) x)))
\ No newline at end of file
+    (define (alist->default-dictionary x) x)
+    (define (default-on-error rewrite 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 implementation-rewriters
+      (list (cons error-object? default-on-error)))))
\ No newline at end of file