+(defun parse-yearstring (string)
+ (let ((year (or (parse-integer-insensitively string)
+ (extract-roman string))))
+ (when (and year (< 1500 year 2500))
+ (make-time :year year))))
+
+(defun parse-integer-insensitively (string)
+ (let ((start (position-if #'digit-char-p string))
+ (end (position-if #'digit-char-p string :from-end t)))
+ (when (and start end)
+ (parse-integer (subseq string start (1+ end)) :junk-allowed t))))
+
+(defvar *roman-digits*
+ '((#\M . 1000)
+ (#\D . 500)
+ (#\C . 100)
+ (#\L . 50)
+ (#\X . 10)
+ (#\V . 5)
+ (#\I . 1)))
+
+(defun extract-roman (string &aux parse)
+ (dotimes (x (length string))
+ (let ((val (cdr (assoc (aref string x) *roman-digits*))))
+ (when (and val parse (< (car parse) val))
+ (push (- (pop parse)) parse))
+ (push val parse)))
+ (apply #'+ parse))
+