About | Profile | まとめ | オリジナル | xyzzy | あんてな | ■ | buzz

About | Profile | まとめ | オリジナル | xyzzy | あんてな | ■ | 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)

• http://github.com/southly/xyzzy.src
• ちょこちょこといじっていたのが面倒になってきたので、githubに置くことにした。
• miyamukoさんのパッチが2つほど入っていないのは、自分の理解がついていっていないから。
• バイナリを置く気は無かったんだけど、ハッシュテーブルのダンプの件の原因が分かったので、直したやつを人柱版として置いておきます。人柱版なので7zで。
• http://cloud.github.com/downloads/southly/xyzzy.src/xyzzy-r20091209.7z
• 何が原因だったかというと、シンボルのハッシュ値がオブジェクトのアドレスから計算してあるんだけど、ダンプ作成時とダンプロード時でシンボルオブジェクトのアドレスが異なり、ハッシュ値も変わっていたから。なのでmaphashで一覧にアクセスするのは前からできた。
• 修正方法はダンプをロードしたあとでrehashするようにしただけ。
• ハッシュテーブルの一覧を得る辺りがイマイチだなぁと思っていたり。もっとうまい書き方ないかなぁ。
• 様子を見つつMLに流す予定(年明け辺りかな)

(ReadMore...)

• CLOCC の f2cl パッケージに BLAS と LAPACK があるのを見つけたので、試してみた。
• 結果: 動かなかった。
• sbcl の場合、FORTRANのソース内で変数名がTのところの、変数の型が違うとエラーが出る。
• でも、FORTRANのソースからトランスレートされたlispのソース内では「t$」になっていて、変数がTの所は見当たらず。(dlamach.f, dlamach.lisp)
• clisp の場合、ちょっと手を入れてロードまで成功。
• テストを動かしてみると何故か zero division error。
• よく分からないので放置。

(ReadMore...)

一番の収穫は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...)

• hgrepos を hgwebdir.cgi に切り替えた。
• hg clone していた人がいたら、しなおした方がよいと思います。
• rss.lisp
• read.lisp
• HEAD にリンクをはる方法があればなぁと思いつつ。
• ファイルごとに文字コードを指定できたらなぁ。
• hgwebdir.cgi で設定してしまえば repository を増やすのに躊躇する必要がないし、いっぱい作っておいた。

• elisp を書く気はさらさらないので (requre 'cl) には拘らないです。
• 具体例として、現在の .emacs はこんな感じです。
• session.el
• tails-history.el
• キーバインドを覚えていないのですが、M-x の履歴で何とかしています。

(ReadMore...)

• MIYAMUKO さんの xyscope.l にインスパイアされて XTAGS 用を書きました。
• builtin-tags.l の辺りにあります。テスト甘いです。
• パッケージは変えるかも。
• builtin.l までジャンプしてこないといけないので、それができる XTAGS を作っておく必要があります。
• 自分は ed::lisp-maketags をいじっているのですが、Nakano さんの ext-lisp-maketags を使えば OK だと思います。
• builtin-function-p → si:*builtin-function-p

さくらのサーバにインストールした clisp で asdf を使うための一連の作業をメモ。

clisp には asdf が付属していないのでソースを取得する。

$ cd $HOME/local/lisp
$ wget "http://cclan.cvs.sourceforge.net/*checkout*/cclan/asdf/asdf.lisp"
$ clisp -c asdf.lisp

ついでにコンパイルしておく。

ここからしばらく clisp での作業。
$HOME/local/lisp/ を lisp ファイル置き場にすることにしたので、ここをロードパスに追加する。

[1]> (push (merge-pathnames "local/lisp/" (user-homedir-pathname)) custom:*load-paths*)
(#P"/home/raido/local/lisp/" #P"./" "~/lisp/**/")

asdf.lisp をロード。

[2]> (load '#:asdf)
;; Loading file /home/raido/local/lisp/asdf.fas ...
;; Loaded file /home/raido/local/lisp/asdf.fas
T

asdf:*central-registry* にパスを追加。$HOME/local/lisp/systems/ にした。
ここに *.asd ファイルへのシンボリックリンクを置くようにする。

[3]> (push (merge-pathnames "local/lisp/systems/" (user-homedir-pathname)) asdf:*central-registry*)
(#P"/home/raido/local/lisp/systems/" *DEFAULT-PATHNAME-DEFAULTS*)

この状態でGUESSを使えるようにする。
ソースをダウンロードして、展開、シンボリックリンクを張る。

$ cd $HOME/local/src/lisp
$ wget http://lispuser.net/files/guess.tar.gz
$ tar xf guess.tar.gz
$ cd ../../lisp/systems/
$ ln -s $HOME/local/src/lisp/guess_0.1.0/guess.asd .

clisp でロード。初回はコンパイルした上でロードしてくれる。

[4]> (asdf:oos 'asdf:load-op :guess)
; loading system definition from /home/raido/local/lisp/systems/guess.asd into #<PACKAGE ASDF0>
;; Loading file /home/raido/local/lisp/systems/guess.asd ...
; registering #<SYSTEM :GUESS #x20538B31> as GUESS
;; Loaded file /home/raido/local/lisp/systems/guess.asd
;; Compiling file /home/raido/local/src/lisp/guess_0.1.0/guess.lisp ...
;; Wrote file /home/raido/local/src/lisp/guess_0.1.0/guess.fas
;; Loading file /home/raido/local/src/lisp/guess_0.1.0/guess.fas ...
;; Loaded file /home/raido/local/src/lisp/guess_0.1.0/guess.fas
0 errors, 0 warnings
NIL

以上。

clisp での作業は初期化ファイルにでも書いておく。clispの場合は $HOME/.clisprc 辺り。

(push (merge-pathnames "local/lisp/" (user-homedir-pathname)) custom:*load-paths*)
(load '#:asdf)
(push (merge-pathnames "local/lisp/systems/" (user-homedir-pathname)) asdf:*central-registry*)
(asdf:oos 'asdf:load-op :guess)

ロードするものが多くなって起動に時間がかかるようになったら、メモリイメージを保存して起動時にこっちを読み込むようにする。

• uchardetを更新した。
• http://raido.sakura.ne.jp/southly/xyzzy/site-lisp/uchardet-20080130.lzh
• 自動判定に成功しているとinsert-file-contentsの時点で内部コードに変換されてしまっていたため、Shift_JISと誤認していた。
• guess-jp-helper のようにファイルから直接読むのが自然だけど、ed::find-file-auto-encodingをいじってみた。
• lyrical-mode もなんとなく更新。ずいぶん前に xyzzy の read をかませるようにしていたのを出すことに。
• http://raido.sakura.ne.jp/southly/xyzzy/site-lisp/lyrical-mode-20080130.lzh

• off会でちょっと出ていたDBの件。
• SQLite辺りがちょうど良いんじゃなかろうか。
• exeもあるから簡単なことならexe経由でできそう。
• ただ、fileを突っ込んだりしたいだろうし専用のexeなりDLLなり作ったほうが良さそう。
• デフォルトのDLLでどの辺までできるか、試してみよう。
• ところで、xyzzyからCの可変長引数の関数を呼ぶってできるんだっけ。
• sqlite3_mprintfが使えると、エスケープを考えずにすみそうで楽なんだけど。
• まぁ、sqlite3_prepareとかsqlite3_bind_xxxで間に合うっちゃ間に合うか。
• All-In-Oneはちょっと依存関係とか調べたら100超えてしまったんで、やっぱりもうちょっと削って分かる範囲でやる予定。

たかだか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...)

でかいファイルを開くときは M-x find-file よりも M-x tail-f。

理由は追っかけていないから確かなことか自信が無いけれど、find-fileで開けなかったサイズがtail-fでは開けたことがあった。undo情報とかが関係しているのかなとか思ってる。
ちょっと思い出した。

　http://iddy.jp/profile/southly/