(let ((sayılar (vector "" "一" "二" "三" "四" "五" "六" "七" "八" "九" "十"))
      (basamaklar (vector "" "" "十" "百" "千" "万")))
  (defun sayı->yazılış (sayı &optional (stream *standard-output*))
    (labels ((öz (sayı basamak)
               (multiple-value-bind (sayı rakam) (truncate sayı 10)
                 (when (> sayı 0)
                   (öz sayı (+ basamak 1)))
                 (case basamak
                   (1 (format stream "~a" (aref sayılar rakam)))
                   (t (case rakam
                        (0)
                        (1 (format stream "~a" (aref basamaklar basamak)))
                        (t (format stream "~a~a"
                                   (aref sayılar rakam)
                                   (aref basamaklar basamak)))))))))
      (cond ((= sayı 0) (format stream "れい"))
            ((> sayı 99999) (error "sayı->yazılış: sayı 99999 dan küçük olmalı"))
            (t (when (< sayı 0)
                 (format stream "マイナス"))
               (öz (abs sayı) 1))))))

;; (defun sayı-sor (tip)
;;   (let* ((sayı (random 99999))
;;          (yazılış (with-output-to-string (str)
;;                     (sayı->yazılış sayı str))))
;;     (case tip
;;       (:rakam
;;        (format t "~a hangi sayıdır? " yazılış)
;;        (let ((girdi (read)))
;;          (if (= girdi sayı)
;;              (format t "doğru.~%")
;;              (format t "yanlış, ~d." sayı))))
;;       (:yazılış
;;        (format t "~a nasıl yazılır? " sayı)
;;        (let ((girdi (string-left-trim '(#\Space) (read-line))))
;;          (if (string-equal girdi yazılış)
;;              (format t "doğru.~%")
;;              (format t "yanlış, ~d." yazılış)))))))

;; (let ((sayılar (vector "" "一" "二" "三" "四" "五" "六" "七" "八" "九" "十")))
;;   (declare (ignorable sayılar))
;;   (defun sayı->yazılış (sayı)
;; 	(let (rakam)
;; 	  (loop :do (multiple-value-setq (sayı rakam) (truncate sayı 10))
;; 			:collect rakam
;; 			:while (> sayı 0)))))