DouKaku?

(define (leap? y)
 (cond
  ((= (modulo y 400) 0) #t)
  ((= (modulo y 100) 0) #f)
  ((= (modulo y 4) 0) #t)
  (#t #f)))

(define (readDate s) (map string->number (string-split s "/")))

(define (getYear d)  (car d))
(define (getMonth d) (cadr d))
(define (getDay d)   (caddr d))

(define (comp func d1 d2)
 (cond
  ((= (func d1) (func d2)) 0)
  ((< (func d1) (func d2)) -1)
  ((> (func d1) (func d2)) 1)))

(define (compYear d1 d2)  (comp getYear d1 d2))
(define (compMonth d1 d2) (comp getMonth d1 d2))
(define (compDay d1 d2)   (comp getDay d1 d2))

(define (compDate d1 d2)
    (if (= (compYear d1 d2) 0)
     (if (= (compMonth d1 d2) 0)
      (if (= (compDay d1 d2) 0)
        0
        (compDay d1 d2))
      (compMonth d1 d2))
     (compYear d1 d2)))

(define (calcYear base d) (- (getYear d) (- (getYear (cadr base)) 1)))

(define (okDate? date)
 (define y (getYear date))
 (define m (getMonth date))
 (define d (getDay date))
 (cond
  ((< m 1)  #f)
  ((< 12 m) #f)
  ((< d 1)  #f)
  ((< 31 d) #f)
  ((and (= d  4) (< 30 d)) #f)
  ((and (= d  6) (< 30 d)) #f)
  ((and (= d  9) (< 30 d)) #f)
  ((and (= d 11) (< 30 d)) #f)
  ((and (leap? y) (= d  2) (< 29 d)) #f)
  ((and (= d  2) (< 28 d)) #f)
  (#t #t)))

(define (makeWareki bases ds)
 (map makeWarekiStr
  (map list (map car bases)
            (map cons (map calcYear bases ds) (map cdr ds)))))

(define (makeWarekiStr wareki)
 (string-append (car wareki)
                (makeDateStr (map number->string (cadr wareki)))))

(define (makeDateStr dateStrs)
 (string-append
    (getYear dateStrs) "年"
    (getMonth dateStrs) "月"
    (getDay dateStrs) "日"))

(define meiji  (list "明治" (readDate "1868/9/8")))
(define taisho (list "大正" (readDate "1912/7/30")))
(define showa  (list "昭和" (readDate "1926/12/25")))
(define heisei (list "平成" (readDate "1989/1/8")))

(define (toWareki ds)
 (define d (readDate ds))
 (cond
  ((not (okDate? d)) "範囲外")
  ((= (compDate d (cadr meiji))  -1) "範囲外")
  ((= (compDate d (cadr taisho)) -1) (makeWareki (list meiji)        (list d)))
  ((= (compDate d (cadr taisho))  0) (makeWareki (list meiji taisho) (list d d)))
  ((= (compDate d (cadr showa))  -1) (makeWareki (list taisho)       (list d)))
  ((= (compDate d (cadr showa))   0) (makeWareki (list taisho showa) (list d d)))
  ((= (compDate d (cadr heisei)) -1) (makeWareki (list showa)        (list d)))
  ((= (compDate d (cadr heisei))  0) (makeWareki (list showa heisei) (list d d)))
  ((= (compDate d (cadr heisei))  1) (makeWareki (list heisei)       (list d)))))