(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))))))))