2010年01月14日

higeponさんから始まったコードバトンに参加。なぜかCommon Lispフォークの方に呼ばれた…

snmsts: 誰もアイデアが無いんだったら自薦者としてはmasatoiさん他薦として higepon(敬称含む)を推します。> naoya_tさん 個人的にはschemerを舐めていきたい。 (※下線は筆者)

Chaton COMMON LISP JP

SchemerとCLerの生暖かい交流(というか人材の奪い合い)が心に残ります。

やったこと

登録された単語からの検索機能 (hige:pan) を実装しました。

  • で、バトンもらったけどこれどうやって動かすのか
  • Snow LeopardにアップグレードしてからCL使ってなくて動かない><
  • sbcl をインストールし直した
  • sbcl にどうやって食わせるんだっけ
$ sbcl
This is SBCL 1.0.29, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.

SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses.  See the CREDITS and COPYING files in the
distribution for more information.
* (load "scheme_baton.lisp")
; ...

T
* (in-package :cl-user)

#<PACKAGE "COMMON-LISP-USER">
* (in-package :hige)

#<PACKAGE "HIGE">
* 

(pon) (pin) (pun) とかして遊べるようになります。

  • 辞書から単語をassocしてくるだけの関数 search-dict の実装
  • 単語を入力し、search-dict で検索し、見つかれば意味を、見つからなければ "Not found." と返すだけの hige:pan を実装
  • aifマクロを追加(というか "On Lisp" からコピペ)
  • (loop :for ... :in ... :do ...)dolist で置き換えてみた

以下diffです:



--- scheme_baton.lisp.orig	2010-01-14 13:35:33.000000000 +0900
+++ scheme_baton.lisp	2010-01-14 20:46:35.000000000 +0900
@@ -49,6 +49,7 @@
 ;;   4. quek (http://read-eval-print.blogspot.com/): 辞書ファイルがない状態からでも (hige:pin) できるようにしました。
 ;;   5. 佐野匡俊 (http://twitter.com/snmsts): ABCLとswingでぬるめのUIを。他の処理系での動作は鐚一文変えるつもりなく結果的に#+/-ABCLまみれ。
 ;;   6. 備前達矢(び) (http://twitter.com/bizenn): SBCL+Mac OS X縛りで出題単語を読み上げ。sayコマンドを叩くだけという手抜きっぷり。
+;;   7. naoya_t (http://blog.livedoor.jp/naoya_t/): 辞書からの単語検索 (hige:pan) を実装。
 
 ;; =================================================================================================================================================
 ;;                            これより下がコードとその説明 - 変更・削除歓迎
@@ -63,6 +64,7 @@
 ;;   (hige:pin)   ; 英単語入力の開始
 ;;   (hige:pon)   ; 英単語ゲームの開始
 ;;   (hige:pun)   ; 辞書の一覧表示
+;;   (hige:pan)   ; 辞書から単語を検索
 ;;   オリジナルはシェルスクリプトとして動作しますが、CL版は現状REPLでの対話です。
 ;;   ※R6RS Schemeで書かれたオリジナル版
 ;;     http://gist.github.com/273431
@@ -78,7 +80,8 @@
   #+ABCL (:shadow :y-or-n-p)
   (:export #:pin
            #:pon
-           #:pun))
+           #:pun
+           #:pan))
 
 (in-package :hige)
 
@@ -105,6 +108,11 @@
 #+ABCL (defun y-or-n-p (fmt &rest args)
 	 (zerop (|showConfirmDialog| |javax.swing.JOptionPane| nil (apply #'format nil fmt args) "y-or-n-p" 0)))
 
+;; aif macro (from "On Lisp")
+(defmacro aif (test-form then-form &optional else-form)
+  `(let ((it ,test-form))
+     (if it ,then-form ,else-form)))
+
 ;;; Special Variables
 (defvar *dict-file* (merge-pathnames ".hige/words.txt" (user-homedir-pathname))
         "Path object for the dictionary file.")
@@ -145,6 +153,12 @@
        (go :again))))
   (save-dict))
 
+(defun pan ()
+  "Search the word user has input from the dictionary"
+  (setup-dict)
+  (let ((word (intern (prompt-read "Word to search"))))
+    (format t "~a" (or (search-dict word) "Not found."))))
+
 ;; pun defined as an alias for dump-dict function (see Auxiliary Functions)
 
 
@@ -169,8 +183,7 @@
   "Save the dictionary data into a file."
   (with-open-file (out file :direction :output :if-exists :supersede)
     (with-standard-io-syntax 
-      (loop :for word :in *dict*
-        :do (print word out)))))
+      (dolist (word *dict*) (print word out)))))
 
 (defun nomalize-dict (dict)
   "Complement entries of a dictionary if one has missing slots."
@@ -197,6 +210,11 @@
         :key #'(lambda (e) 
                  (- (entry-ng-count e) (entry-ok-count e)))))
 
+(defun search-dict (word)
+  "Search the dictionary for a word."
+  (aif (assoc word *dict*)
+	   (entry-meaning it)
+	   NIL))
 
 ;;; Auxiliary Functions for the User Interface
 (defun p (&rest args)

Schemeの方(本流)にも参戦しなくては。



(23:28)

トラックバックURL

この記事にコメントする

名前:
URL:
  情報を記憶: 評価: 顔