(defun leap-year-p (y)
  (do ((i y (1- i))
       (c4 (%clist 4) (cdr c4))
       (c100 (%clist 100) (cdr c100))
       (c400 (%clist 400) (cdr c400)))
      ((zerop i) (or (and (car c100) (car c400))
                     (and (not (car c100)) (car c4))))))

(defun %clist (freq)
  (let ((l (make-list freq)))
    (setf (car l) t)
    (rplacd (last l) l)
    l))