(define (roman->number roman)
  (let ((romans '((#\M 1000) (#\D 500) (#\C 100) (#\L 50) (#\X 10) (#\V 5) (#\I 1))))
    (let loop ((roman (map char-upcase (string->list roman))) (prior 10000) (number 0))
      (cond ((null? roman) number)
            ((< prior (cadr (assoc (car roman) romans)))
              (loop (cdr roman)
                    10000
                    (+ number (cadr (assoc (car roman) romans)) (* prior -2))))
            (else (loop (cdr roman)
                        (cadr (assoc (car roman) romans))
                        (+ number (cadr (assoc (car roman) romans)))))))))

(define (number->roman n)
  (if (and (integer? n) (> n 0))
      (let loop ((n n)
                 (romans '((1000 #\M) (500 #\D) (100 #\C) (50 #\L) (10 #\X) (5 #\V) (1 #\I)))
                 (boundaries '(100 100 10 10 1 1 #f))
                 (s '()))
        (if (null? romans)
            (list->string (reverse s))
            (let ((roman-val (caar romans))
                  (roman-dgt (cadar romans))
                  (bdry (car boundaries)))
              (let loop2 ((q (quotient n roman-val))
                          (r (remainder n roman-val))
                          (s s))
                (if (= q 0)
                    (if (and bdry (>= r (- roman-val bdry)))
                        (loop (remainder r bdry) (cdr romans)
                              (cdr boundaries)
                              (cons roman-dgt
                                    (append
                                      (cdr (assv bdry romans))
                                      s)))
                        (loop r (cdr romans) (cdr boundaries) s))
                    (loop2 (- q 1) r (cons roman-dgt s)))))))
      (error 'number->roman "only positive integers can be romanized")))

(define (add-roman . xs)
  (number->roman (apply +
    (map roman->number xs))))

(display (add-roman "CCCLXIX" "CDXLVIII"))

DCCCXVII