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

擬似乱数生成器 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)))

• 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)

• 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))

(ReadMore...)

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)>"

(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...)

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

(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 " --/--(--) --:-- ")))))

http://d.hatena.ne.jp/pgf2/20080415/1208269126
ざっくりとした違いは関数は全ての引数が評価される、マクロとスペシャルフォームはそうとは限らないという点です。
関数が評価されるときは、まず引数を前から順番に評価し、全部の引数を評価したらその値を用いて関数のフォームを評価するという風に評価順序が決まっています。
マクロやスペシャルフォームは、評価順序が一定でなかったり、全ての引数が評価されなかったりします。
例えばスペシャルフォームの「if」はTHEN節とELSE節のどちらか一方しか評価されません。
評価規則が決まっている関数の枠組みでは「if」は定義できないということになります。

マクロの特徴は展開できるということです。
展開形は macroexpand や macroexpand-1 で確認できます。

スペシャルフォームは「3.1.2.1.2.1 Special Forms」で挙げられているものです。
マクロとスペシャルフォームの関係は排他的ではないので、マクロでありかつスペシャルフォームというものがある実装もあるかもしれません。

まとめとして setq と set と setf の関係
(setq a "value") と (set (quote a) "value") はほぼ等価。(厳密には違います。xyzzyでその差が出るかどうかは不明)
(setq a "value") と (setf a "value") は等価。
なぜなら

(macroexpand '(setf a "value"))
=>(setq a "value")

だから。

• http://d.hatena.ne.jp/rairairou/20080410/1207837409
• ステータスバーを消せないっていうのは、亀井さんの発言で確かです。ステータスバーはエコー領域として必要ですし。
• タイトルバーを消せないっていうのは、どこの誤情報なんだろ? タイトルバーは普通に消せます。

;;; 消す
(progn
  (winapi:SetWindowLong (get-window-handle)
                        winapi:GWL_STYLE
                        (logand (winapi:GetWindowLong (get-window-handle) winapi:GWL_STYLE)
                                (lognot (logior winapi:WS_CAPTION winapi:WS_SYSMENU))))
  (winapi:SetWindowPos (get-window-handle) 0 0 0 0 0 (logior winapi:SWP_NOZORDER winapi:SWP_NOSIZE winapi:SWP_NOMOVE winapi:SWP_FRAMECHANGED)))

;;; 戻す
(progn
  (winapi:SetWindowLong (get-window-handle)
                        winapi:GWL_STYLE
                        (logior (winapi:GetWindowLong (get-window-handle) winapi:GWL_STYLE) winapi:WS_CAPTION winapi:WS_SYSMENU))
  (winapi:SetWindowPos (get-window-handle) 0 0 0 0 0 (logior winapi:SWP_NOZORDER winapi:SWP_NOSIZE winapi:SWP_NOMOVE winapi:SWP_FRAMECHANGED)))

;;; ちなみにステータスバーを消そうとする
(winapi:ShowWindow (winapi:FindWindowEx (get-window-handle) 0 (si:make-string-chunk "msctls_statusbar32") 0) winapi:SW_HIDE)

• xyzzy でできるできないの判断をするには、lispの知識とWindowsのAPIの知識とxyzzyの実装の知識が必要で、オレでも安易に結論を出せないです。
• できないって結論を出す前に質問として流すようにしてくれないかなぁ。
• ついでに改ページの話
• http://d.hatena.ne.jp/himadatanode/20080411/p5

xyzzyだと^\fなんて入ってなくてそのまま^Lが入っているような気がするんだけど

$XYZZY/lisp/page.l を読んでいて、なぜ以下の部分(18行目)に気付かなかったのか不思議。xyzzy のリファレンスを参照していなさそうなのも不思議。

(or (boundp 'page-delimiter)
    (setq page-delimiter "^\f"))

• 改ページの使用例で覚えているもの
• プログラムのソースに書かれているのは、ごくまれに見たことがあるなぁ。
• xyzzy ML の過去ログを読んでいれば遭遇するけど、なかださんがパッチと本文の区切りとして使っていたりする。(xyzzy:08621とか)

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以上全部になっているし)

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

(ReadMore...)

• マクロ展開が起こるのは評価時 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と書いてありました。

clispはサーバーのOSバージョンが上がっても動いていたけど、clispの方もバージョンが上がっているので入れなおしてみた。
いまいちうまくいっていないのでもう一回入れなおそう。

必要なライブラリであるlibsigsegvがきっちり認識されない。
libsigsegvはコンパイルはできるがチェックでエラーが出る状態。

$make check
Making check in src
Making check in tests
make  check-TESTS
Test passed.
PASS: sigsegv1
Test passed.
PASS: sigsegv2
FAIL: stackoverflow1
FAIL: stackoverflow2
===================
2 of 4 tests failed
===================
*** Error code 1

Stop in /home/raido/local/src/libsigsegv-2.5/tests.
*** Error code 1

Stop in /home/raido/local/src/libsigsegv-2.5/tests.
*** Error code 1

Stop in /home/raido/local/src/libsigsegv-2.5.

ということで --ignore-absence-of-libsigsegv を追加して作成。
本当は --with-module=bindings/glibc も指定する予定だったけれどうまくいかず、結局以下のような感じでインストール。

cd local/src/
wget http://ring.sakura.ad.jp/archives/GNU/clisp/release/2.43/clisp-2.43.tar.bz2
tar xf clisp-2.43.tar.bz2 
cd clisp-2.43
./configure --ignore-absence-of-libsigsegv --prefix=$HOME/local --with-module=rawsock --with-module=wildcard
cd src/
make
make check
make install

できあがった物。

$ clisp --version
GNU CLISP 2.43 (2007-11-18) (built 3410886803) (memory 3410887057)
Software: GNU C 3.4.4 [FreeBSD] 20050518 
gcc -g -O2 -Igllib -W -Wswitch -Wcomment -Wpointer-arith -Wimplicit -Wreturn-type -Wmissing-declarations -Wno-sign-compare -O2 -fexpensive-optimizations -falign-functions=4 -DUNICODE -DDYNAMIC_FFI -DNO_GETTEXT -DNO_SIGSEGV -I. -x none libavcall.a libcallback.a -lreadline -lncurses 
SAFETY=0 HEAPCODES STANDARD_HEAPCODES SPVW_BLOCKS SPVW_MIXED TRIVIALMAP_MEMORY
libreadline 5.0
Features: 
(READLINE REGEXP SYSCALLS I18N LOOP COMPILER CLOS MOP CLISP ANSI-CL COMMON-LISP
 LISP=CL INTERPRETER SOCKETS GENERIC-STREAMS LOGICAL-PATHNAMES SCREEN FFI
 UNICODE BASE-CHAR=CHARACTER PC386 UNIX)
C Modules: (clisp i18n syscalls regexp readline)
Installation directory: /home/raido/local/lib/clisp-2.43/
User language: ENGLISH
Machine: I386 (I386) www658.sakura.ne.jp [59.106.19.88]

なるほど。

(*do-completion "quit" :list nil '("quit-recursive-edit" "quit-and-back" "quit-char" "quit" "quit"))
=>:not-unique
=>("quit" "quit" "quit-char" "quit-and-back" "quit-recursive-edit")
=>nil

こうなることを考えると do-completion-internal で対応するのがよさそう。

そして、めも。

If it is accessible as an internal symbol via use-package, it is first imported into package, then exported. (The symbol is then present in the package whether or not package continues to use the package through which the symbol was originally inherited.)

CLHS: Function EXPORT: http://www.lisp.org/HyperSpec/Body/fun_export.html

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