[[About:self:AboutPage.txt]] | [[Profile:file/southly/]] | [[まとめ:self:1163859357.txt]] | [[オリジナル:http://ninjinix.x0.com/rn/]] | [[xyzzy:lisp/]] | [[あんてな:listall]] | [[■:lisp]] | [[buzz:files/southly#buzz]]

• debian squeeze でsbclインストール後のコア作成に失敗していた。
• 以下がエラーメッセージ。

; #<PACKAGE "ASDF1">
; registering #<SYSTEM SB-GROVEL {B4F1921}> as SB-GROVEL
;
; compilation unit aborted
;   caught 1 fatal ERROR condition

Error running init-common-lisp-controller-v4: Lock on package SB-IMPL violated
                                              when interning NATIVE-FILE-KIND.
See also:
  The SBCL Manual, Node "Package Locks"

• 以下のように修正して解決した。

--- /usr/share/common-lisp/source/common-lisp-controller/post-sysdef-install.lisp~      2010-02-28 17:58:19.000000000 +0900
+++ /usr/share/common-lisp/source/common-lisp-controller/post-sysdef-install.lisp       2010-02-28 18:01:36.000000000 +0900
@@ -61,7 +61,7 @@
 #+sbcl
 (defun get-owner-and-mode (directory)
   (when (eq :directory
-           (sb-impl::native-file-kind (namestring directory)))
+           (sb-unix::unix-file-kind (namestring directory)))
     ;; check who owns it
     (multiple-value-bind (res dev ino mode nlink uid gid rdev size atime mtime)
        (sb-unix:unix-stat (namestring directory))

で、以下を実行。

$ sudo dpkg-reconfigure common-lisp-controller

• http://git.debian.org/?p=pkg-common-lisp/common-lisp-controller.git;a=commit;h=7e511abe9551237095f395c2f75bb7f7aa580094
• squeeze でインストールされるsbclは今のところ 1.0.25 なんだけど、sb-unix::unix-file-kindがリネームされるのはこれ以降のバージョンなんじゃなかろうか。

• Scheme コードバトン (CL fork)
• やったことは以下の通り。
• untabify
• format指示子を大文字に揃える
• インデントを調整
• 辞書が存在しない時の動作を修正
• package-nameがprintされないようにして、オリジナルの辞書と似た感じの出力を目指した
• asdfのパッケージ化
• lispの関数は10行越えると、理解が大変になってくる。修行が足りないなぁ
• xyzzy lispでforkしようかと思っていたけれど、ABCLの動作と似た感じになるだろうから、微妙。

diff --git a/package.lisp b/package.lisp
new file mode 100644
index 0000000..3667c7a
--- /dev/null
+++ b/package.lisp
@@ -0,0 +1,13 @@
+;; -*- Mode: Lisp; Syntax: Common-Lisp -*-
+
+;;; Package Management
+(in-package :cl-user)
+
+(defpackage :hige
+  (:use :cl)
+  #+ABCL (:shadow :y-or-n-p)
+  (:export #:pin
+           #:pon
+           #:pun
+           #:pan
+           #:pen))
diff --git a/scheme_baton.asd b/scheme_baton.asd
new file mode 100644
index 0000000..b2d9ce6
--- /dev/null
+++ b/scheme_baton.asd
@@ -0,0 +1,4 @@
+(defsystem :scheme_baton
+  :serial t
+  :components ((:file "package") (:file "scheme_baton"))
+  )
diff --git a/scheme_baton.lisp b/scheme_baton.lisp
index 27713dc..fc50ad7 100644
--- a/scheme_baton.lisp
+++ b/scheme_baton.lisp
@@ -53,6 +53,7 @@
 ;;   8. masatoi (http://d.hatena.ne.jp/masatoi/): n択問題(hige:pen)を実装．英単語から意味を問うのと意味から英単語を問うのと選べる．named-let使いまくり．
 ;;   9. cranebird (http://d.hatena.ne.jp/cranebird/): CL と言えばマルチパラダイムなので CLOS を。with-系のマクロを追加。
 ;;  10. smeghead (http://d.hatena.ne.jp/smeghead/): 単語のスコアを導入した。問題の単語表示時にスコアを表示するようにした。単語の一覧表示(hige:pun)にキーワード引数 score-thresholdを追加。
+;;  11. NANRI (http://raido.sakura.ne.jp/southly/rn/): デバッグとちょっとした整理。あと (asdf:oos 'asdf:load-op :scheme_baton) でロードできるようにした。
 ;;
 ;; =================================================================================================================================================
 ;;                            これより下がコードとその説明 - 変更・削除歓迎
@@ -79,18 +80,6 @@
 ;; ■辞書ファイルの例
 ;;   http://gist.github.com/273424
 
-;;; Package Management
-(in-package :cl-user)
-
-(defpackage :hige
-  (:use :cl)
-  #+ABCL (:shadow :y-or-n-p)
-  (:export #:pin
-           #:pon
-           #:pun
-           #:pan
-           #:pen))
-
 (in-package :hige)
 
 ;;quek-san's  http://read-eval-print.blogspot.com/2009/04/abcl-java.html without cl-ppcre
@@ -177,25 +166,25 @@
        (format *debug-io* "done~%"))
      *dict*))
 
-(defmacro with-entries ((entry) &rest body)
+(defmacro do-entries ((entry) &rest body)
   `(dolist (,entry (entries-of *dict*))
      ,@body))
 
 ;;; Top-Level Functions
 (defun pin ()
   "Register new entries to the dictionary."
-  (unless *dict-file*
-    (ensure-directories-exist *dict-file*))
   (with-dict ()
-    (loop (add-entry (prompt-for-entry))
-       (if (not (y-or-n-p "Another words to register? [yn]: ")) (return)))))
+    (loop 
+      (add-entry (prompt-for-entry))
+      (unless (y-or-n-p "Another words to register? [yn]: ")
+        (return)))))
 
 (defun pon ()
   "Start self-study english vocabulary quiz."
   (with-dict ()
-    (with-entries (e)
+    (do-entries (e)
       (p "~&~A (score: ~D): " (read-aloud (entry-word e)) (entry-score e))
-      (ready?)
+      #-ABCL (ready?)
       #-ABCL (p "~&~A [Ynq]: " (entry-meaning e))
       :again
       (case (query #+ABCL (entry-meaning e))
@@ -209,12 +198,12 @@
 (defun pan ()
   "Search the word user has input from the dictionary"
   (with-dict (:read-only t)
-    (let ((word (intern (prompt-read "Word to search") :hige)))
+    (let ((word (intern (prompt-read "Word to search") #.*package*)))
       (format t "~A" (or (search-dict word) "Not found.")))))
 
 (defun pun (&key score-threshold)
-  (if (and score-threshold
-           (not (numberp score-threshold)))
+  (when (and score-threshold
+             (not (numberp score-threshold)))
     (error "pun: score-threshold must be number."))
   (setup-dict)
   (dump-dict :score-threshold score-threshold))
@@ -226,7 +215,7 @@
   (with-dict ()
     (when (> n-choice (length (entries-of *dict*))) ; 辞書の長さチェック
       (error "Dictionary size is too small .~%"))
-    (with-entries (e)
+    (do-entries (e)
       (p "~&~A (score: ~D): "
          (if meaning? (entry-meaning e) (read-aloud (entry-word e)))
          (entry-score e))
@@ -239,13 +228,15 @@
            :do (p "~A.~A  " i (if meaning? (entry-word item) (entry-meaning item))))
         (p " [1-~Aq]: " n-choice)
         (nlet itr ((query (read *query-io* nil nil)))
-          (cond ((and (numberp query) (> query 0) (> (1+ n-choice) query))
+          (cond ((and (numberp query) (< 0 query (1+ n-choice)))
                  (if (= query correct-answer)
                      (incf (entry-ok-count e))
                      (incf (entry-ng-count e))))
-                ((and (symbolp query) (string= (symbol-name query) "Q")) (return))
-                (t (p "~&Please type number of the choice or Q for quit.~%[1-3q]: ")
-                   (itr (read *query-io* nil nil)))))))))
+                ((and (symbolp query) (string= (symbol-name query) "Q")) 
+                 (return))
+                (t
+                 (p "~&Please type number of the choice or Q for quit.~%[1-3q]: ")
+                 (itr (read *query-io* nil nil)))))))))
 
 ;;; Auxiliary Functions
 (defun setup-dict (&key (fn #'sort-dict-standard) (file *dict-file*))
@@ -261,36 +252,51 @@
   (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)))
+                          :ok-count (or (ignore-errors (entry-ok-count e)) 0)
+                          :ng-count (or (ignore-errors (entry-ng-count e)) 0)))
           entries))
 
+(defmacro with-dictionary-io-syntax (&body body)
+  `(with-standard-io-syntax
+       (let ((*readtable* (copy-readtable nil))
+             (*package* #.*package*) ; 単語Symbolのホームは:higeパッケージです。
+             (*read-eval* nil))
+         (setf (readtable-case *readtable*) :preserve) ; 単語Symbolは大文字小文字を区別して扱います。
+         ,@body)))
+
 (defun read-dict (file)
   "Read dictionary data from a file."
-  (let ((*readtable* (copy-readtable nil))
-        (*package* #.*package*)) ; 単語Symbolのホームは:higeパッケージです。
-    (setf (readtable-case *readtable*) :preserve) ; 単語Symbolは大文字小文字を区別して扱います。
-    (with-open-file (in file)
-      (normalize-dict
-       (loop :for word := (read in nil in) :until (eq word in)
-          :collect word)))))
+  (unless (probe-file file)
+    (return-from read-dict NIL))
+  (with-open-file (in file)
+    (with-dictionary-io-syntax
+        (normalize-dict
+         (loop :for word := (read in nil in) :until (eq word in)
+               :collect word)))))
 
 (defun save-dict (&key (file *dict-file*))
   "Save the dictionary data into a file."
-  (with-open-file (out file :direction :output :if-exists :supersede)
-    (with-standard-io-syntax
-      (dolist (word (entries-of *dict*)) (print word out)))))
+  (unless (probe-file file)
+    (ensure-directories-exist file))
+  (with-open-file (out file
+                       :direction :output
+                       :if-exists :supersede
+                       :if-does-not-exist :create)
+    (with-dictionary-io-syntax
+        (let ((*package* #.*package*))
+          (dolist (word (entries-of *dict*)) (print word out))))))
 
 (defun dump-dict (&key score-threshold)
   "Print the dictionary in CSV format."
   (let ((output (format nil "~{~{~A~^,~}~%~}"
                         (if (null score-threshold)
-                          (entries-of *dict*) ;score-thresholdが指定されない場合は全件
-                          (remove nil ;score-thresholdが指定された場合は絞り込む
-                                  (mapcar (lambda (e)
-                                            (if (<= (entry-score e) score-threshold)
-                                              e))
-                                          (entries-of *dict*)))))))
+                            (entries-of *dict*) ; score-thresholdが指定されない場合は全件
+                            (delete NIL ; score-thresholdが指定された場合は絞り込む
+                                    (mapcar (lambda (e)
+                                              (if (<= (entry-score e) score-threshold)
+                                                  e
+                                                  NIL))
+                                            (entries-of *dict*)))))))
     #-ABCL (format t "~A" output)
     #+ABCL (|showMessageDialog| |javax.swing.JOptionPane| nil output)))
 
@@ -324,7 +330,6 @@
                 (1 #\N)
                 (2 #\Q)))
 
-
 (defun prompt-read (prompt)
   #-ABCL (progn
            (p "~A: " prompt)

一番の収穫はCLOSについての理解が深まったこと。
xyzzyで使えないものだから、ちゃんと勉強したことが無くて:beforeとか:afterとかよく分かってなかったんだけど、やっと分かった。（とりあえず使ってみようと思うくらいには）
メソッド結合かぁ〜 よく考えたもんだなぁ〜
C++やJavaなんかのメソッドがクラスに属しているオブジェクト指向とは全くの別物だ。頭を切り替えて使わないといけない。

帰省中に付箋を付けながら読んでいたので、拾い上げておく。

• p.7 括弧にある「他の本では読者の課題として残してあるもの」というのは中規模のプログラムなのか、言語の説明なのか
• p.10 *5 CMU も略語なんだから「Carnegie Mellon University」とした方がいいような。本文に「カーネギーメロン大学」とあるから英語の方にはいらなかったんだろうけど。
• p.25 if, not 説明なしで登場。（これ以降も関数が説明なしで登場するのがあったな）
• p.26 *5 「これは都合がいいこと」の「これ」が指すものが分かりにくい。たぶんスラッシュを解釈する方。
• p.37 where は短くなってるか？ 別関数に処理を追い出しただけのような。コードを見る。
• p.41 *6 浮動小数点の要求精度を確認する。浮動小数点と整数が同じ型になる場合があると読めなくもないとするのは意地が悪いか？
• p.45 special form の一覧を確認する。
• p.47 *7 言われてみればと納得。確かにマクロか関数かで悩んだ覚えが無いけど、無意識にこういう感じで判別していたんだな。
• p.57 &optionalと&keyの組み合わせは注意。
• p.69 *11 スレッドごとにダイナミック変数。
• p.71 「ローカル変数としてtが使えないのは、たまにイラっとくる」←あるある（笑）
• p.78 「構文」は「syntax」の訳じゃないのかな。確認する。
• p.81 ここで気づいたけど「Common Lisp」と言ったり「Lisp」と言ったりしてるな。英語は繰り返しを避けるからか。
• p.81 *5 深いなぁ
• p.91 マクロを書くステップ。
• p.98 マクロを書くときの注意点。
• p.121 バックスラッシュが足りない。正誤表にあったのはここか。
• p.127 「LENGTH、ELT、ELTに対する〜」←eltの連続が気になるなぁ。「そして」とか挟めばよかったかも。
• p.129 関数名は大文字じゃないのだろうか。関数名じゃないということか？確認する。
• p.137 こんな後ろにconsが初出。
• p.143 副作用の結果が規定されている関数もある。
• p.144 非破壊的→共有 破壊的→共有されていないことが前提。
• p.144 イディオム push+nreverse setf+delete
• p.145 mergeも破壊的。
• p.146 (caar (list 1 2 3)) はエラーになるよね。確認する。
• p.147 null は空リストのテスト。
• p.149 「幻想」が気になる。原文を確認。
• p.149 proper listの訳は「真リスト」か。個人的には「純リスト」とか「正リスト」とか「正規リスト」とかのイメージ。
• p.152 「塊を操作する」が気になる。原文を確認。
• p.152 集合論なんだから「和集合」とか「積集合」とかの用語を入れて欲しいなぁ。
• p.153 連想リストって出てきたっけ？
• p.155 plistはeqで比較。
• p.157 *4 分かりにくいけどsetfでsymbol-plistをそっくり置き換える話か。(setf (symbol-plist 'foo) nil)みたいな。
• p.166 文字列→パスネーム pathname、パスネーム→文字列 namestring
• p.170 ディレクトリを作る→ensure-directories-exist
• p.172 「配管」は気になる。原文を確認。
• p.218 パディングに全角文字を指定したらどうなる？
• p.251 「コンパイル時に情報を使って保存して〜」よく分からない表現。原文を確認。「コンパイル時に同じファイルに保存してある情報を使って」ってこと？
• p.253 ここでやっとintern
• p.268 「(CLer)黒帯のためのLOOP」のニュアンスなのか。なるほど。
• p.285 「この場合にはincrement-countの2番目のx引数として渡された〜」変なxが紛れ込んでる。
• p.308 マクロ内で名前を生成しない。
• p.311 「どの型をread-valueに渡xすか〜」変なxが紛れ込んでる。
• p.312 prognメソッド結合
• p.325 「ここでのミソは、それらの数値をxどうやって〜」変なxが紛れ込んでる。
• p.445 「処理系依存のライブラリを使う不利な点は唯一、〜」←「唯一」は前に持ってきて「処理系依存のライブラリを使う唯一の不利な点は、〜」とかの方が自然かも。

[[(ReadMore...) index.rb?1218973151.txt]]

ステータスバーの表示をいじるね〜
どんな情報があったらうれしいのだろうか。
モード行もあるしな〜

(start-timer 1.0 #'(lambda ()
                     (when (string= "T" *status-bar-format*)
                       (winapi:SendMessage (winapi:FindWindowEx (get-window-handle) 0 (si:make-string-chunk "msctls_statusbar32") 0)
                                           #x0401 1 (si:make-string-chunk " --/--(--) --:-- ")))))

xmls で日本語を出力するには、write-escaped を修正する。
例えば以下のような感じ。

(in-package :xmls)
(defun write-escaped (string stream)
  "Writes string to stream with all character entities escaped."
  (coerce string 'simple-base-string)
  (when (eq stream t) (setf stream *standard-output*))
  (loop for char across string
        for esc = (if (< (char-code char) (length *char-escapes*))
                      (svref *char-escapes* (char-code char))
                      (string char))
        do (write-sequence esc stream)))

ただ、xmls で出力した xml はあんまり見慣れない書き方になるみたいなので使わない気がする。

s-xml の場合は print-string-xml に手を入れればいいと思う。
が、どの範囲をそのまま出力するようにするかが悩ましい。
UTF-8で出力することが前提ならなら ASCII 以上は全部でも良いとは思うけど、文字コード・文字集合辺りはよく分からないなあ。(上のはASCII以上全部になっているし)

• マクロ展開が起こるのは評価時 or コンパイル時という理解でした。
• xyzzy の動作はまさしくこれですよね。
• sbcl はインタプリタがないので定義と同時にコンパイルされて、納得の結果。
• ecl はよく知らない。
• clisp の結果は自分にとってはちょっと不思議。
• 気になったので CLtL2 を確認してみたら、8章の最初のページにありました。

More generally, an implementation of Common Lisp has great latitude in deciding exactly when to expand macro calls within a program. For example, it is acceptable for the defun special form to expand all macro calls within its body at the time the defun form is executed and record the fully expanded body as the body of the function being defined.

で、例えば defun での関数定義時にマクロを展開することもOKと書いてありました。

とりあえずできた。REPL では動作確認できた。
要 cl-interpol。
SANO さんの情報がなかったらどうにか interpol-reader を使えないか、悩んでいたかも。サンクスです。
[[(ReadMore...) index.rb?1204642645.txt]]

たかだか3つの関数のためにemacs.lに依存するのはもったいないと思ったので、てきとーに実装してみました。
GPLなんですしemacs.lからもってくるのもありかと。
マイナーモードにする関数はed::toggle-modeを使いましょう。それでelisp::prefix-numeric-valueは不要になります。

• elisp::count-lines
• elisp::expand-file-name
• elisp::prefix-numeric-value

(defun count-line(beg end)
  (if (eql beg end)
      0
    (1+ (- (save-excursion
             (goto-char end)
             (when (eql (preceding-char) #\LFD) (backward-char))
             (current-line-number))
           (save-excursion
             (goto-char beg)
             (current-line-number))))))

(defun expand-file-name (file &optional (dir (default-directory)))
  (merge-pathnames file dir))

[[(ReadMore...) index.rb?1196394719.txt]]