http://raido.sakura.ne.jp/southly/rn/ NANRIの関心事(xyzzyとかlispとか)、その他もろもろを http://raido.sakura.ne.jp/southly/rn/?1172004099.txt 2007-02-21 擬似乱数生成器 Xorshift RNGs ってのを見つけた。 　http://lucille.atso-net.jp/blog/?p=9 書いてみる (let ((x 123456789) (y 362436069) (z 521288629) (w 88675123)) (defun xor128 () (let ((a (logxor x (logand #xFFFFFFFF (ash x 11))))) (shiftf x y z w) (setq w (logxor (logxor w (ash w -19)) (logxor a (ash a -8))))))) (dotimes (i 100) (format t "~8,'0x~%" (xor128))) 2010-04-28T12:55:48+09:00 http://raido.sakura.ne.jp/southly/rn/?HeaderPage.txt Menu [[About:self:AboutPage.txt]] | [[Profile:http://iddy.jp/profile/southly/]] | [[まとめ:self:1163859357.txt]] | [[オリジナル:http://ninjinix.x0.com/rn/]] | [[xyzzy:http://raido.sakura.ne.jp/southly/xyzzy/site-lisp/]] | [[あんてな:http://i-know.jp/southly/listall]] | [[■:http://raido.sakura.ne.jp/southly/lisp/ni/view.lisp]] | [[buzz:http://www.google.com/profiles/southly#buzz]] 2010-04-10T13:05:06+09:00 http://raido.sakura.ne.jp/southly/rn/?1267349508.txt 2010-02-28 : - 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がリネームされるのはこれ以降のバージョンなんじゃなかろうか。 2010-02-28T19:05:29+09:00 http://raido.sakura.ne.jp/southly/rn/?1264012172.txt 2010-01-20 - 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) &amp;rest body) +(defmacro do-entries ((entry) &amp;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 "~&amp;~A (score: ~D): " (read-aloud (entry-word e)) (entry-score e)) - (ready?) + #-ABCL (ready?) #-ABCL (p "~&amp;~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 (&amp;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 "~&amp;~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 "~&amp;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 "~&amp;Please type number of the choice or Q for quit.~%[1-3q]: ") + (itr (read *query-io* nil nil))))))))) ;;; Auxiliary Functions (defun setup-dict (&amp;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 (&amp;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 (&amp;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 (&amp;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) 2010-01-21T03:29:33+09:00 http://raido.sakura.ne.jp/southly/rn/?1263826256.txt 近況など - 実は一月から退職して地元福岡に戻っています。 - 最近のxyzzyいじりは現実逃避の産物ですね(苦笑) - 去年の夏ぐらいから家庭の事情でごたごたしてまして、何とか今月中に落ち着ける体制を整えたいところ。 - Shibuya.lisp方面は半端状態で本当に申し訳ないです。 2010-01-18T23:50:57+09:00 http://raido.sakura.ne.jp/southly/rn/?1261321159.txt 2009-12-20 : - src/gen-syms.ccのコンパイルで「error: pasting "V" and "*" does not give a valid preprocessing token」と言われる。 - トークン連結演算子ではなく文字列リテラルとして結合するしかないかな… #define XDEF(a, b, c, d, e, f, g) {a, b, c, d, e, f, g} #define XDEFSF(a, b, c) XDEF (a, b, c, 2, 0, FFspecial_form, 0) #define XSI_DEFSF3(name) XDEFSF (STR (name), "Fsi_" STR(name), "Ssi_" STR(name)) #define XDEFUN(a, b, c, d, e, f) XDEF (a, b, c, d, e, f, 0) #define XDEFUN3(name, req, opt, f) \ XDEFUN (STR (name), "F" STR (name), "S" STR (name), req, opt, f) #define XSI_DEFUN3(name, req, opt, f) \ XDEFUN (STR (name), "Fsi_" STR(name), "Ssi_" STR (name), req, opt, f) #define XVDEF(a, b, c) {a, 0, b, 0, 0, c} #define XDEFCONST(a, b) XVDEF (a, b, SFconstant | SFspecial) #define XDEFCONST2Q(name) XDEFCONST (STR (name), "Q" STR (name)) #define XDEFVAR(a, b) XVDEF (a, b, SFspecial) #define XDEFVAR2(name) XDEFVAR (STR (name), "V" STR(name)) #define XSI_DEFVAR2(name) XDEFVAR (STR (name), "Vsi_" STR (name)) #define XMAKE_SYMBOL(a, b) XVDEF (a, b, 0) #define XMAKE_SYMBOL2(name) XMAKE_SYMBOL (STR (name), "V" STR (name)) #define XMAKE_SYMBOL2QC(name) XMAKE_SYMBOL (STR (name), "QC" STR (name)) #define XSI_MAKE_SYMBOL2(name) XMAKE_SYMBOL (STR (name), "Vsi_" STR(name)) ---- ソース書き換え無しでビルドプロセスをいじってよいならg++ -Eを一旦中間ファイルに落とすのは簡単にいけますけど…いまいち。 佐野 ---- bulbさんのやり方が一番修正が少なくていいかなぁと。 あんまり理解してませんが、http://docs.sun.com/app/docs/doc/821-0386/bjakk?l=ja&amp;a=viewで紹介されているK&amp;R Cでのトークン連結方法の前者のやり方が使えるということなんだと思います。 -- NANRI 2010-01-15T19:06:08+09:00 http://raido.sakura.ne.jp/southly/rn/?1261140315.txt xyzzy : ブランチまで作ってしまったので、各ブランチの説明なんかを書いておきます。 - master -- リリースブランチ -- 今のところ修正パッチだけを取り込む予定。 -- バイナリを配布するとしたらこのブランチだけど、今のところ未定。 -- 相談事は http://fixdap.com/p/xyzzy/34387/ でやれたらいいかなと思ってます。 - for-gcc -- unstableブランチ -- Linuxへ移植したいなぁ。そのためにはg++でビルドできないとなぁ。ということで、MinGWでのビルドを目指してみます。 -- こっちの相談事は http://fixdap.com/p/xyzzy/34389/ でやれたらいいかなと思ってます。 - nanri-master -- unstableブランチ -- NANRIによるオレオレバージョンのxyzzy -- 好き勝手にやります。 gitなのでforkしてもらえたら、適当にpullします。 2009-12-18T22:50:48+09:00 http://raido.sakura.ne.jp/southly/rn/?1260294123.txt xyzzy : - http://github.com/southly/xyzzy.src - ちょこちょこといじっていたのが面倒になってきたので、githubに置くことにした。 - miyamukoさんのパッチが2つほど入っていないのは、自分の理解がついていっていないから。 - バイナリを置く気は無かったんだけど、ハッシュテーブルのダンプの件の原因が分かったので、直したやつを人柱版として置いておきます。人柱版なので7zで。 - http://cloud.github.com/downloads/southly/xyzzy.src/xyzzy-r20091209.7z - 何が原因だったかというと、シンボルのハッシュ値がオブジェクトのアドレスから計算してあるんだけど、ダンプ作成時とダンプロード時でシンボルオブジェクトのアドレスが異なり、ハッシュ値も変わっていたから。なのでmaphashで一覧にアクセスするのは前からできた。 - 修正方法はダンプをロードしたあとでrehashするようにしただけ。 - ハッシュテーブルの一覧を得る辺りがイマイチだなぁと思っていたり。もっとうまい書き方ないかなぁ。 - 様子を見つつMLに流す予定(年明け辺りかな) ---- 何かお手伝いできれば良いのですが。 for-gccブランチとかで。 bulb. ---- forkしていただけると、勝手にpullできるので個人的にはらくちんです。 for-gccは一応MinGWでビルドできるようにすることを目指してやっています。 Makefileの修正とアセンブラの修正で何とかなるかなぁとか思ってましたが、gen-syms.ccのプリプロセスでうまくいっていないみたいでいきなり頓挫しています(^^; こうすればうまくいったとか、ここがうまくいかないとかの情報の共有ができたらいいですね。 -- NANRI 2009-12-18T22:50:36+09:00 http://raido.sakura.ne.jp/southly/rn/?1245670321.txt 2009-06-22 : http://d.hatena.ne.jp/bowbow99/20090616/1245135962 ライブラリの依存関係を見てくれるコンパイル&amp;ロードシステムができれば、 そういうのがもう少しやりやすくなるだろうなぁ。 # Common Lispでいうところのasdfのようなもの 2009-06-22T20:32:02+09:00 http://raido.sakura.ne.jp/southly/rn/?1238933006.txt 2009-04-05 : clispもバージョンアップしておこうと思ったけれど、ビルドに失敗。 gcc: Internal error: Killed: 9 (program cc1) Please submit a full bug report. See <URL:http://gcc.gnu.org/bugs.html> for instructions. gmake: *** [io.o] Error 1 これってコンパイルできないというか、gccがエラーを出してるのかな? ちょっと心配なエラーメッセージだ。妙にレスポンスが悪かったからその辺りが関係しているのだろうか。 FFIを有効にする方法とかちゃんと調べてもう一度チャレンジしよう。 ---- このエラーはメモリ不足なんかでおきる類いみたい。たしかにレスポンス鈍かったし、ここのところ負荷が高い感じなので納得。少し様子見てみよう。 2009-04-06T21:34:56+09:00 http://raido.sakura.ne.jp/southly/rn/?1238907160.txt 2009-04-05 : さくらサーバーのOSがバージョンアップしたので、ソフトをアップデートした。 * lv lv はコマンドを打ち慣れているので入れることに。 wget "http://www.ff.iij4u.or.jp/~nrt/freeware/lv451.tar.gz" tar xf lv451.tar.gz cd lv451 cd build/ ../src/configure --prefix=$HOME/local make make install * Subversion 1.6.0 へバージョンアップ。 svn+ssh:// でアクセスするのに失敗したので、$HOME/bin にシンボリックリンクを作って回避。 とりあえず動いているみたい。 wget http://subversion.tigris.org/downloads/subversion-1.6.0.tar.gz wget http://subversion.tigris.org/downloads/subversion-deps-1.6.0.tar.gz tar xf subversion-1.6.0.tar.gz tar xf subversion-deps-1.6.0.tar.gz cd subversion-1.6.0 ./configure --prefix=$HOME/local --with-ssl --without-berkeley-db gmake gmake install cd cd bin ln -s ../local/bin/svn . ln -s ../local/bin/svnserve . ln -s ../local/bin/svnadmin . ln -s ../local/bin/svnversion . ln -s ../local/bin/svnlook . ln -s ../local/bin/svnsync . ln -s ../local/bin/svndumpfilter . 参考: - http://kayakaya.net/d/20090323.html#p01 - http://d.hatena.ne.jp/spdog/20080202/p1 merge-tracking がようやく使えるようになった。ということで repository を dump &amp; load して作り直しておいた。(もしかしたら不要だったかも) マージが楽になると良いな。 * git ついでなのでgitも入れておくことにした。 wget http://kernel.org/pub/software/scm/git/git-1.6.2.2.tar.gz tar xf git-1.6.2.2.tar.gz cd git-1.6.2.2 ./configure --prefix=$HOME/local --without-tcltk gmake gmake install 参考: - http://sho.tdiary.net/20090324.html 2009-04-06T11:12:16+09:00 http://raido.sakura.ne.jp/southly/rn/?1237620463.txt 2009-03-21 : print-objectを定義するとprincとprin1の両方に影響するんだなぁ 別々に定義することはできないんだろうか。 と思ったらできた。 princとprin1の差は*print-escape*に現れるので、この値で分岐すれば良かった。*print-readably*かと勘違いしてた。 (defclass point () ((x :initform (random 100)) (y :initform (random 100)))) (make-instance 'point) ;=> #<POINT {121573B1}> (defmethod print-object ((object point) stream) (if *print-escape* (print-unreadable-object (object stream :type t) (format stream "(~D, ~D)" (slot-value object 'x) (slot-value object 'y))) (format stream "(~D, ~D)" (slot-value object 'x) (slot-value object 'y)))) (make-instance 'point) ;=> #<POINT (53, 69)> (format nil "~A" (make-instance 'point)) ;=> "(55, 81)" (format nil "~S" (make-instance 'point)) ;=> "#<POINT (41, 71)>" ---- (defclass point () ((x :initform (random 100)) (y :initform (random 100)))) (make-instance 'point) ;=> #<POINT {122403B1}> (defmethod print-object ((object point) stream) (print-unreadable-object (object stream :type t) (format stream "(~D, ~D)" (slot-value object 'x) (slot-value object 'y)))) (make-instance 'point) ;=> #<POINT (88, 12)> (format nil "~A" (make-instance 'point)) ;=> "#<POINT (98, 53)>" (format nil "~S" (make-instance 'point)) ;=> "#<POINT (88, 53)>" 2009-03-22T00:49:22+09:00 http://raido.sakura.ne.jp/southly/rn/?1236620769.txt 2009-03-10 : - http://gist.github.com/76387 - 後でもうちょっときれいにまとめます。 - たぶん、swankをロードした後にロードすれば使えると思います。 - 本当はHyperSpecから情報を引き出したかったんですが、どうしてもうまくいかずsbclから引っこ抜きました。 - slime.elを読んでslime-eval-printのようにelispの代わりにclを呼ぶのに使えるような関数を探してみるというテーマを今更思いつきました。これはいずれまたの機会にやってみようと思います。 2009-03-10T02:46:10+09:00 http://raido.sakura.ne.jp/southly/rn/?1236000743.txt 2009-03-02 : - g000001さんに倣いSICPをちょこちょこと読み始めた。 - http://github.com/southly/reading.sicp/tree/master - clozure clはIntel Macでも案外普通に動くな。 - インストールはこれだけだったし。 $ svn co http://svn.clozure.com/publicsvn/openmcl/release/1.3/darwinx86/ccl - しばらく試してみよう。 2009-03-02T22:32:24+09:00 http://raido.sakura.ne.jp/southly/rn/?1235480701.txt 2009-02-24 : - 忘れそうなので hexl を NetInstaller に対応しておいた。 2009-02-24T22:05:02+09:00