(defconstant xp-table
  '(((0 . (0 +))         5     1)
    ((1 . 1)	        10     3)
    (((1 +) . (1 +))    15     4)
    ((2 . 2)		20     5)
    (((2 +) . (2 +))	25    10)
    ((3 . 3)		30    15)
    (((3 +) . (3 +))	50    25)
    ((4 . 4)		75    50)
    (((4 +) . (4 +))   125    75)
    ((5 . 5)	       175   125)
    (((5 +) . (5 +))   225   175)
    ((6 . 6)	       275   225)
    (((6 +) . (6 +))   350   300)
    ((7 . 7)	       450   400)
    (((7 +) . (7 +))   550   475)
    ((8 . 8)	       650   550)
    (((8 +) . (8 +))   775   625)
    ((9 . 9)	       900   700)
    (((9 +) . 10)     1000   750)
    (((10 +) . 11)    1100   800)
    (((11 +) . 12)    1250   875)
    (((12 +) . 13)    1350   950)
    (((13 +) . 14)    1500  1000)
    (((14 +) . 15)    1650  1050)
    (((15 +) . 16)    1850  1100)
    (((16 +) . 17)    2000  1150)
    (((17 +) . 18)    2125  1350)
    (((18 +) . 19)    2250  1550)
    (((19 +) . 20)    2375  1800)
    (((20 +) . 21)    2500  2000)))

(defun parse-hd-spec (spec &optional start end)
  (unless start (setf start 0))
  (unless end (setf end (length spec)))
  (multiple-value-bind
      (hd e)
      (parse-integer spec :start start :end end :junk-allowed t)
    (when (and (< e end)
	       (char= (char spec e) #\+))
      (incf e)
      (multiple-value-bind
	  (hunoz ee)
	  (parse-integer spec :start e :end end :junk-allowed t)
	(declare (ignore hunoz))
	(setf e ee)
	(setf hd (list hd '+))))
    (unless (loop for i from e below end
		  never (char/= (char spec i) #\*))
      (error "bad hit dice string"))
    (let ((stars (- end e)))
      (flet ((hd<= (a b)
	       (let ((aa (if (consp a) (car a) a))
		     (bb (if (consp b) (car b) b)))
		 (or (< aa bb)
		     (and (= aa bb)
			  (or (consp a)
			      (not (consp b))))))))
	(loop for ((lo . hi) base bonus) in xp-table
	      when (and (hd<= lo hd)
			(hd<= hd hi))
	      return (+ base (* stars bonus))
	      finally (let* ((hd-base (if (consp hd) (car hd) hd))
			     (hd-plus (if (consp hd) 1 0))
			     (steps (+ hd-base -21 hd-plus)))
			(return (+ 2500
				   (* 250 steps)
				   (* (+ 2000 (* 250 steps)) stars)))))))))

(defmacro hd (sym)
  `(parse-hd-spec ',(princ-to-string sym)))