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