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 コードバトンするのはどうか? (3)

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

前回のエントリーも依然としてカオスかなあと思ったので、lequeさんのエントリーも参照しつつ、さらに単純にしてみました。

よくよく考えてみると、単語のエントリーを破壊的に変更していくのが楽ですね。

(defpackage :hige
  (:use :cl))

(in-package :hige)

(defstruct (entry (:type list))
  word meaning ok-count ng-count)

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

(defun nomalize-dict (dict)
  (mapcar (lambda (e)
            (make-entry :word (entry-word e) 
                        :meaning (entry-meaning e)
                        :ok-count (or (entry-ok-count e) 0)
                        :ng-count (or (entry-ng-count e) 0)))
          dict))

(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 word-spec*
        #'>
        :key (lambda (e) 
               (- (entry-ng-count e) (entry-ok-count e)))))

(defun query ()
  (prog2                       ;1年に1度も遭遇するかしないかのprog2が使いたい状況
    (clear-input *query-io*)
    (read-char *query-io*)
    (clear-input *query-io*)))

(defun pr (&rest args)
  (apply #'format *query-io* args))

(defun ready? ()
  (read-char *query-io*))

;; main
(defun main (file)
  (let ((dict (sort-word-spec* (read-dict file))))
    (dolist (e dict)
      (pr "~&~A: " (entry-word e))
      (ready?)    
      (pr "~&~A y/n? " (entry-meaning e))
    :again
      (case (query)
        ((#\Y #\y) (incf (entry-ok-count e)))
        ((#\N #\n) (incf (entry-ng-count e)))
        ((#\Q #\q) (return))
        (otherwise
           (pr "~&Please type Y for yes or N for no or Q for quit.~%")
           (go :again))))
    (write-dict file dict)))