Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2010-01-10

Shibuya.lisp に向けて Scheme コードバトンするのはどうか? (2)

| 01:19 | Shibuya.lisp に向けて Scheme コードバトンするのはどうか? (2) - わだばLisperになる を含むブックマーク はてなブックマーク - Shibuya.lisp に向けて Scheme コードバトンするのはどうか? (2) - わだばLisperになる

前回のエントリーのコードだとカオス過ぎるかなと思ったので、心の赴くままに関数を分解してみました。

対話周りは、折角のCLなのでコンディションシステムを使って処理した方が良いような気もしています。

(defpackage :hige
  (:use :cl)
  (:import-from :kmrcl :aand :it)
  (:import-from :shibuya.lisp :fn))

(in-package :hige)

(defun read-dict (file)
  (with-open-file (in file)
    (read in)))

(defun write-dict (file data)
  (with-open-file (out file :direction :output :if-exists :supersede)
    (with-standard-io-syntax 
      (print data out))))

(defun sort-word-spec* (word-spec*)
  (sort (loop :for (word meaning ok-count ng-count) :in word-spec*
              :collect (list word meaning (or ok-count 0) (or ng-count)))
        #'>
        :key (fn ((ign ore ok-count ng-count))
               (- ng-count ok-count))))

(defun ask (catch-tag 
            result-spec* word-spec
            word more meaning ok-count ng-count)
  (flet ((*query ()
           (clear-input *query-io*)
           (prog1 (read-char *query-io*)
                  (clear-input *query-io*)))
         (*pr (&rest args)
           (apply #'format *query-io* args))
         (*ready? () (read-char *query-io*)))
    (tagbody 
       (*pr "~A: " word)
       (*ready?)    
       (*pr "~A y/n? " meaning)
     :again
       (return-from ask
         (case (*query)
           ((#\y #\Y) (list word meaning (1+ ok-count) ng-count))
           ((#\n #\N) (list word meaning ok-count (1+ ng-count)))
           ((#\q #\Q) (throw catch-tag 
                        `(,@result-spec* ,word-spec ,@more)))
           (otherwise
              (*pr "~&Please type Y for yes or N for no or Q for quit.~%")
              (go :again)))))))

;; main
(defun main (file)
  (aand (read-dict file)
        (catch 'break
          (loop :for (word-spec . more) :on (sort-word-spec* it)
                :for (word meaning ok-count ng-count) := word-spec
                  :collect (ask 'break
                                result-spec* word-spec
                                word more meaning ok-count ng-count)
                     :into result-spec*
                :finally (return result-spec*)))
        (write-dict file it)))