(define-library (cuprate implementation foment)
  (import (foment base) (scheme base) (srfi 166) (srfi 225) (srfi 128) (srfi 125))
  (export pretty-print default-test-dto
          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)
    (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)))))