(defconstant tab '(("" "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX")
                   ("" "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC")
                   ("" "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM")
                   ("" "M" "MM" "MMM"                                )))

(defconstant exc '((18 "XIIX") (22 "IIXX")))

(defun roman (x base)
  (unless (zerop x)
    (concatenate 'string
                 (roman (floor x 10) (cdr base))
                 (nth   (mod   x 10) (car base)))))

(defun romanus-maximus (x)
  (check-type x (integer 1 3999))
  (or (second (assoc x exc))
      (roman x tab)))