#:g1: frontpage

 

Emacs Lisp: nadviceの紹介

Posted 2014-10-25 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の299日目です。

Emacs Lisp: nadviceとはなにか

 Emacs Lisp: nadviceは、

パッケージ情報

パッケージ名Emacs Lisp: nadvice
Emacs LispマニュアルAdvising Functions - GNU Emacs Lisp Reference Manual

インストール方法

 Emacs 24.4から使える機能で、nadvice.elで定義されています。

試してみる

 これまで色々な処理系でアドバイス機構を紹介してきましたが、今回も同様に、

(defun matu (x)
  (princ (format ">>%s<<\n" x))
  nil)     

(matu 8) ;>> >>8<< ;=> nil

のような関数があったとすると、

;>> around1 ==>
;>> around0 ==>
;>> before1:
;>> before0:
;>> >>8<<
;>> after0: 
;>> after1: 
;>> around0 <== 
;>> around1 <== 
;=> NIL

のような結果を得るには、

(defun matu-around0 (f &rest args)
  (prog2
    (princ "around0 ==>\n")
    (apply f args)
    (princ "around0 <==\n")))

(defun matu-around1 (f &rest args) (prog2 (princ "around1 ==>\n") (apply f args) (princ "around1 <==\n")))

(defun matu-before0 (&rest args) (princ "before0:\n"))

(defun matu-before1 (&rest args) (princ "before1:\n"))

(defun matu-after0 (&rest args) (princ "after0:\n"))

(defun matu-after1 (&rest args) (princ "after1:\n"))

(advice-add 'matu :before #'matu-before0) (advice-add 'matu :before #'matu-before1) (advice-add 'matu :after #'matu-after0) (advice-add 'matu :after #'matu-after1) (advice-add 'matu :around #'matu-around0) (advice-add 'matu :around #'matu-around1)

こんな感じの定義と定義順になります。定義順に内側から外側へ付加されていきますが、オプションのalistのdepth属性で制御することが可能です。-100から100までで-100が最も外側とのこと。デフォルトは0。
ということで上記を定義順は関係なく同様の構成にしたい場合は、

(advice-add 'matu :around #'matu-around0 '((depth . -2)))
(advice-add 'matu :around #'matu-around1 '((depth . -2)))
(advice-add 'matu :before #'matu-before0 '((depth . 0)))
(advice-add 'matu :before #'matu-before1 '((depth . -1)))
(advice-add 'matu :after #'matu-after0 '((depth . 0)))
(advice-add 'matu :after #'matu-after1 '((depth . -1)))

のようになるかと思います。
アドバイスの削除は、advice-removeで

(advice-remove 'matu #'matu-around1)

のようにしますが、名前付き関数を指定していることから分かるように無名関数でアドバイスを付けてしまうと取り外しが面倒なことになります。

before/after/around以外の仲間達

 定番のbefore/after/around以外にも7つ程パタンが増えたみたいです。
どういう挙動になるかは、add-functionのドキュメンテーションストリングを読む方が早いかもしれませんが、

`:before'	(lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r))
`:after'	(lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r)))
`:around'	(lambda (&rest r) (apply FUNCTION OLDFUN r))
`:override'	(lambda (&rest r) (apply FUNCTION r))
`:before-while'	(lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r)))
`:before-until'	(lambda (&rest r) (or  (apply FUNCTION r) (apply OLDFUN r)))
`:after-while'	(lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r)))
`:after-until'	(lambda (&rest r) (or  (apply OLDFUN r) (apply FUNCTION r)))
`:filter-args'	(lambda (&rest r) (apply OLDFUN (funcall FUNCTION r)))
`:filter-return'(lambda (&rest r) (funcall FUNCTION (apply OLDFUN r)))

適当に試してみると下記のような感じです。

(defun foo (n) n)

(list (foo 0) (foo 42)) ;=> (0 42)

(advice-add 'foo :override #'zerop)

(list (foo 0) (foo 42)) ;=> (t nil)

(advice-remove 'foo #'zerop)

(advice-add 'foo :before-while #'zerop) ;=> nil

(list (foo 0) (foo 42)) ;=> (0 nil) (advice-remove 'foo #'zerop) ;=> nil

(advice-add 'foo :before-until #'zerop) ;=> nil

(list (foo 0) (foo 42)) ;=> (t 42)

(advice-remove 'foo #'zerop) ;=> nil

(advice-add 'foo :after-while #'zerop) ;=> nil

(list (foo 0) (foo 42)) ;=> (t nil)

(advice-remove 'foo #'zerop) ;=> nil

(advice-add 'foo :after-until #'zerop) ;=> nil

(list (foo 0) (foo 42)) ;=> (0 42)

(advice-remove 'foo #'zerop) ;=> nil

(advice-add 'foo :filter-return #'1+) ;=> nil

(foo 1) ;=> 2

(defun bar (&rest args) (length args))

(bar 1 2 3) ;=> 3

(advice-add 'bar :filter-args #'print)

(bar 1 2 3) ;>> (1 2 3) ;=> 3

メソッド結合でいうとandやorみたいなものが追加された感じですね。
ちなみにadvice-add、advice-removeは、それぞれよりプリミティブなadd-function、remove-functionを呼び出しています。これらの詳細はマニュアルを参照してください。

まとめ

 今回は、Emacs Lisp: nadviceを紹介してみました。
新しい方式は、普通の関数呼び出しの合成という感じなので、馴染み易いかもしれないですね。

cl-difflibの紹介

Posted 2014-10-23 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の297日目です。

cl-difflibとはなにか

 cl-difflibは、John Wiseman氏作のPythonのdifflibのCommon Lisp版です。

パッケージ情報

パッケージ名cl-difflib
Quicklisp
CLiKiCLiki: CL-DIFFLIB
Quickdocscl-difflib | Quickdocs
CL Test Grid: ビルド状況cl-difflib | CL Test Grid

インストール方法

(ql:quickload :cl-difflib)

試してみる

 どんな関数があるかは、Quickdocsで確認できます。

 Pythonのdifflibそのままの名前ではありませんが、大体対応するものは同じ名前になっているようです。

に対応するのは、大体

  • context-diff
  • get-close-matches
  • get-opcodes
  • group-opcodes
  • sequence-matcher
  • quick-similarity-ratio
  • unified-diff
  • very-quick-similarity-ratio

位でしょうか。

(difflib:unified-diff *standard-output*
                      '("one" "two" "three" "four" "five" "six")
                      '("one" "three" "four" "seven" "six")
                      :test-function #'equal)
;>>  ---  
;>>  +++  
;>>  @@ -1,6 +1,5 @@
;>>   one
;>>  -two
;>>   three
;>>   four
;>>  -five
;>>  +seven
;>>   six
;=>  <no values>

(difflib:context-diff *standard-output* '("one" "two" "three" "four" "five" "six") '("one" "three" "four" "seven" "six") :test-function #'equal) ;>> *** ;>> --- ;>> *************** ;>> *** 1,6 *** ;>> one ;>> - two ;>> three ;>> four ;>> ! five ;>> six ;>> --- 1,5 ---- ;>> one ;>> three ;>> four ;>> ! seven ;>> six ;=> <no values>

(difflib:get-close-matches (string 'multiple-value-bind) (mapcar #'string (*:list-external-symbols :alexandria))) ;=> ("MULTIPLE-VALUE-PROG2" "MULTIPLE-VALUE-COMPOSE")

(difflib:get-close-matches (string 'list) (mapcar #'string (*:list-external-symbols :alexandria))) ;=> ("DOPLIST")

(difflib:quick-similarity-ratio (make-instance 'difflib:sequence-matcher :a "abcd" :b "bcde" :test-function #'equal)) ;=> 3/4

使い方も大体同じです。

まとめ

 今回は、cl-difflibを紹介してみました。
他の言語のライブラリをCommon Lispに移植したものの一覧もいつか作ってみたいですね。

Emacs 24.4でskk + slime + pareditの競合を回避

Posted 2014-10-23 04:30:00 GMT

 前に書いた、skk + slime + pareditの競合をアドバイスで回避する方法ですが、

slimeがlexical-binding: tで書かれるようになった所為か、elispのdefadviceのad-arglistあたりとの組み合わせがどうも良くない感じになっていました。
どうもアドバイスの方はダイナミックスコープで動作している様子でarglistの参照がすっぽ抜けます。
Emacs 24.4でアドバイスが新しい方式に変わったとのことで、もしかしたらこの辺りが解決されているのかなと思って試してみました。
ざっと書いてみたところ、

;; -*-lexical-binding:t-*-
(require 'skk)
(require 'skk-azik)
(require 'paredit)
(require 'slime)

;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; paredit & skk ;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;

(defun paredit-semicolon\\skk-kakutei (origfun &rest arglist) "skk-azikで ?; で「っ」を出している場合に競合するのを回避" (apply (cond (skk-j-mode ;; skk-modeでかな入力(mode-lineに「かな/カナ」とある状態)の場合 ;; skk-insertへ処理を投げる #'skk-insert) (t ;; それ以外は、通常のparedit-semicolon origfun)) arglist))

(advice-add 'paredit-semicolon :around #'paredit-semicolon\\skk-kakutei) ;; (advice-add 'paredit-semicolon #'paredit-semicolon\\skk-kakutei)

(defun paredit-open-square\\skk-insert (origfun &rest arglist) "skkのカナ/かな切り替えが[になってしまうのを回避" (apply (cond (skk-j-mode ;; skk-modeでかな入力(mode-lineに「かな/カナ」とある状態)の場合 ;; skk-insertへ処理を投げる #'skk-insert) (t ;; それ以外は、通常のparedit-open-square origfun)) arglist))

(advice-add 'paredit-open-square :around #'paredit-open-square\\skk-insert) ;; (advice-remove 'paredit-open-square #'paredit-open-square\\skk-insert)

(defun paredit-newline\\skk-kakutei (origfun &rest arglist) "skk-mode時に かな→asciiの一方通行になってしまうのを回避" (apply (cond ((not skk-mode) ;; skk-modeでなければparedit-newlineの動作で良い origfun) (t ;; skk-modeでは、skk-kakuteiで、skk-j-modeへ入る #'skk-kakutei)) arglist))

(advice-add 'paredit-newline :around #'paredit-newline\\skk-kakutei) ;; (advice-remove 'paredit-newline #'paredit-newline\\skk-kakutei)

;;;;;;;;;;;;;;;;;;;;;;; ;;;;; slime & skk ;;;;; ;;;;;;;;;;;;;;;;;;;;;;;

(defun slime-space\\skk-insert (origfun &rest arglist) "skkの変換(スペース)がslime-spaceに食われてしまうのを回避" (apply (cond (skk-henkan-mode ;; skk-henkan-mode中であれば(▽▼の時)skk-insertへ処理を投げる #'skk-insert) (t ;; それ以外は通常のslime-space origfun)) arglist))

(advice-add 'slime-space :around #'slime-space\\skk-insert) ;; (advice-remove 'slime-space #'slime-space\\skk-insert)

;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; slime-repl & skk ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun slime-handle-repl-shortcut\\skk-insert (origfun &rest arglist) "slime-replで「、」が「,」になるのを回避" (cond (skk-j-mode (insert "、")) (t (apply origfun arglist))))

(advice-add 'slime-handle-repl-shortcut :around #'slime-handle-repl-shortcut\\skk-insert) ;; (advice-remove 'slime-handle-repl-shortcut #'slime-handle-repl-shortcut\\skk-insert)

(defun slime-repl-newline-and-indent\\skk-kakutei (origfun &rest arglist) "slime-replで確定動作が改行になるのを回避" (apply (cond ((not skk-mode) ;; skk-modeでなければparedit-newlineの動作で良い origfun) (t ;; skk-modeでは、skk-kakuteiで、skk-j-modeへ入る #'skk-kakutei)) arglist))

(advice-add 'slime-repl-newline-and-indent :around #'slime-repl-newline-and-indent\\skk-kakutei) ;; (advice-remove 'slime-repl-newline-and-indent :around #'slime-repl-newline-and-indent\\skk-kakutei)

という感じになりました。
方式がシンプルに関数の組み合わせになったので書くのも楽といえば楽。
スコープ方式が入り乱れた場合のarglistのスコープの問題も関数の入れ子になるので解決かなと思われます。
なお、同じパタンが何度か出ているのでまとめようかなとも思いましたが、まとめるのが面倒だったのでベタ書きしています。

cl-qprintの紹介

Posted 2014-10-22 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の296日目です。

cl-qprintとはなにか

 cl-qprintは、Robert Marlow氏とMax Rottenkolber氏によるRFC 2045のQuoted-Printableを扱うライブラリです。

パッケージ情報

パッケージ名cl-qprint
Quicklisp
CLiKiCLiki: cl-qprint
Quickdocscl-qprint | Quickdocs
CL Test Grid: ビルド状況cl-qprint | CL Test Grid

インストール方法

(ql:quickload :cl-qprint)

試してみる

 どんな関数があるかは、Quickdocsで確認できます。

 内容はシンプルにencodeとdecodeのみ。
入力にはオクテットかオクテットのストリームが使えます。

(qprint:encode (*:string-to-octets "Now's the time for all folk to come to the aid of their country."))
;=>  "Now's=20the=20time=20for=20all=20folk=20to=20come=20to=20the=20aid=20of=20th=^M
;    eir=20country."

(qprint:decode (qprint:encode (map 'vector #'char-code "Now's the time for all folk to come to the aid of their country."))) ;=> #(78 111 119 39 115 32 116 104 101 32 116 105 109 101 32 102 111 114 32 97 108 ; 108 32 102 111 108 107 32 116 111 32 99 111 109 101 32 116 111 32 116 104 101 ; 32 97 105 100 32 111 102 32 116 104 101 105 114 32 99 111 117 110 116 114 121 ; 46)

(with-open-stream (in (*:make-byte-array-input-stream (*:string-to-octets "Now's the time for all folk to come to the aid of their country."))) (qprint:encode in)) ;=> "Now's=20the=20time=20for=20all=20folk=20to=20come=20to=20the=20aid=20of=20th=^M ; eir=20country."

(with-open-stream (in (*:make-byte-array-input-stream (*:string-to-octets "おはよう日本おはよう日本おはよう日本"))) (qprint:encode in)) ;=> "=E3=81=8A=E3=81=AF=E3=82=88=E3=81=86=E6=97=A5=E6=9C=AC=E3=81=8A=E3=81=AF=E3=^M ; =82=88=E3=81=86=E6=97=A5=E6=9C=AC=E3=81=8A=E3=81=AF=E3=82=88=E3=81=86=E6=97=^M ; =A5=E6=9C=AC"

(*:octets-to-string (qprint:decode (qprint:encode (*:string-to-octets "おはよう日本おはよう日本おはよう日本")))) ;=> "おはよう日本おはよう日本おはよう日本"

まとめ

 今回は、cl-qprintを紹介してみました。
一発物は紹介が楽です。

cl-cronの紹介

Posted 2014-10-21 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の295日目です。

cl-cronとはなにか

 cl-cronは、Mackram Ghassan Raydan氏作のCommon Lispでのcron実装です。

パッケージ情報

パッケージ名cl-cron
Quicklisp
CLiKiCLiki: cl-cron
Quickdocscl-cron | Quickdocs
CL Test Grid: ビルド状況cl-cron | CL Test Grid

インストール方法

(ql:quickload :cl-cron)

試してみる

 どんな関数があるかは、Quickdocsで確認できます。

 Lisp処理系でcron的なものを実現したものは幾つかあるようなのですが、cl-cronは処理系内部からLispの関数を実行するタイプのようです。

(cron:start-cron)

(cron:stop-cron)

で実行開始/停止で、ジョブの投入には、make-cron-jobを利用します。

(cron:make-cron-job (lambda () (print "hello")))

とすれば、毎分helloを出力するジョブが投入されます。実行時刻の指定は大体cronと同じです。

start-cronは、起動時にcron:*cron-load-file*で指定したファイルを読みに行くので、このファイルにジョブを記載しておけばまとめてジョブを投入できます。

(setq cron:*cron-load-file* "~/.cl-cron")

として、~/.cl-cronに、

;;; 毎時の0、15、30、45で実行
(cron:make-cron-job (lambda () (print "hello"))
                    :minute '(0 15 30 45)) 

;;; 毎週月曜の0:00に実行 (cron:make-cron-job (lambda () (print "hello")) :minute 0 :hour 0 :day-of-week 0)

;;; 毎分実行 (cron:make-cron-job (lambda () (print "hello")))

;;; *EOF*

のようなものを定義して利用することが可能です。

まとめ

 今回は、cl-cronを紹介してみました。
Common Lisp製のデーモンかなにかの中で定期実行したい場合に便利そうですね。

glintの紹介

Posted 2014-10-20 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の294日目です。

glintとはなにか

 glintは、Naoki Koguro氏作のGauche用のコードチェッカーです。

パッケージ情報

パッケージ名glint
プロジェクトサイトglint

インストール方法

 プロジェクトサイトからダウンロードしてきて、configure/make/make installでglintコマンドが生成されます。

 Gauche 0.8.13用とのことで、最新のGaucheでは動作未確認かと思います。

試してみる

 glintがリリースされたのは、2008年のことで早6年前になりますが、当時開催のgauche.night #2での発表の動画がありますので、これを観るのが一番分かりやすいかなと思います。

 glintではGauche内部の中間表現を元にチェックしているのでGaucheの実際の動作に即した詳細な結果が得られます。

 一応、以前のsclintの例+αで比べてみると、

(define (foo x)
  (if (= x 0)
	1
           (foo (- x 1))))

(if 1 2 3 4)

(define)

(let () a)

(if (= car x 0) a b)

(define morlis (lambda (x) x))

(define (morlis y) y)

;; (use srfi-42) (list-ec (: e '(1 2 3 4)) e)

のようなものだと、

$ glint /tmp/foo.scm
/tmp/foo.scm:6: error: syntax-error: malformed if: (if 1 2 3 4)
/tmp/foo.scm:8: error: syntax-error: (define)
/tmp/foo.scm:10: error: a(user) referenced but not defined
/tmp/foo.scm:12: error: a(user) referenced but not defined
/tmp/foo.scm:12: error: b(user) referenced but not defined
/tmp/foo.scm:12: error: x(user) referenced but not defined
/tmp/foo.scm:20: error: #<generic object-apply (8)> can't be applied with arguments (: #<unidentified> (1 2 3 4))
/tmp/foo.scm:20: error: e(user) referenced but not defined
/tmp/foo.scm:20: error: list-ec(user) referenced but not defined

のような感じになります。
(use srfi-42)を有効にすれば、

/tmp/foo.scm:6: error: syntax-error: malformed if: (if 1 2 3 4)
/tmp/foo.scm:8: error: syntax-error: (define)
/tmp/foo.scm:10: error: a(user) referenced but not defined
/tmp/foo.scm:12: error: a(user) referenced but not defined
/tmp/foo.scm:12: error: b(user) referenced but not defined
/tmp/foo.scm:12: error: x(user) referenced but not defined

のようにエラーも減少します。

まとめ

 今回は、glintを紹介してみました。
動画のデモにもありますが、Emacsのflymakeからも使えるようになっていて便利そうです。

Lucid CL: Adviceの紹介

Posted 2014-10-19 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の293日目です。

Lucid CL: Adviceとはなにか

 Lucid CL: Adviceは、Lucid CLのアドバイス機構です。

パッケージ情報

パッケージ名Lucid CL: Advice
ドキュメントLiquid CL: 6.3 The Advice Facility

インストール方法

 Lucid CL/Liquid CLでは標準で使えます。LCLパッケージで定義されていますが、CL-USERからも使えるようになっています。

試してみる

 今回もこれまでのアドバイス機構の紹介と同じ例ですが、Lucid CL版で他と違っているのは、基本的にaroundのみで、それを他のアドバイスの内側に追加するか、外側に追加するかを指定するという所です。
動作的には、aroundしかないのでbeforeに相当するものは、最後にadvice-continueし、afterは、最初にadvice-continueしてから後の処理を追加する、という感じになります。
動作的にと書いたのは、ややこしいことに、:insideの別名として:after、:outsideの別名として:beforeが使えるからなのですが、:before/:afterで考えると混乱するので、ここでは、:inside/:outsideのみで紹介します。
ちなみに、指定しなければデフォルトで:outsideを指定したことになります。
尚、Lucid CLのアドバイスも定義する順番で動作が変わるので定義順が重要になっています。

(defun matu (x)
  (format t "~&>>~A<<~%" x))

(matu 8) ;>> >>8<< ;=> NIL


(defadvice (matu around0) (n)
  (prog2
    (write-line "around0 ==>")
    (advice-continue n)
    (write-line "around0 <==")))

(defadvice (matu around1 (:outside around0)) (n) (prog2 (write-line "around1 ==>") (advice-continue n) (write-line "around1 <==")))

(defadvice (matu before0 (:inside around0)) (n) (write-line "before0:") (advice-continue n))

(defadvice (matu before1 (:outside before0)) (n) (write-line "before1:") (advice-continue n))

(defadvice (matu after0 (:inside around0)) (n) (prog1 (advice-continue n) (write-line "after0:")))

(defadvice (matu after1 (:outside after0)) (n) (prog1 (advice-continue n) (write-line "after1:")))

(matu 8) ;>> around1 ==> ;>> around0 ==> ;>> before1: ;>> before0: ;>> >>8<< ;>> after0: ;>> after1: ;>> around0 <== ;>> around1 <== ;=> NIL

 また、マクロにもアドバイスは定義可能です。

(defmacro mydefun (name (&rest args) &body body)
  `(defun ,name (,@args) ,@body))

(defadvice (mydefun inline) (form env) (destructuring-bind (def name args &body body) form (declare (ignore def args body)) `(progn (declaim (inline ,name)) ,(advice-continue form env))))

(mydefun foo (n) n) ;===> (PROGN (DECLAIM (INLINE FOO)) (DEFUN FOO (N) N))

 他、アドバイスの削除には、remove-adviceが使え、アドバイスのdescribeには、describe-adviceが定義されています。

(describe-advice 'matu)
;>> Advice AROUND1: #<Interpreted-Function (:ADVICE MATU AROUND1) C0E767>
;>>   Advice AROUND0: #<Interpreted-Function (:ADVICE MATU AROUND0) C0E717>
;>>     Advice AFTER1: #<Interpreted-Function (:ADVICE MATU AFTER1) C0E6C7>
;>>       Advice AFTER0: #<Interpreted-Function (:ADVICE MATU AFTER0) C0E677>
;>>         Advice BEFORE1: #<Interpreted-Function (:ADVICE MATU BEFORE1) C0E627>
;>>           Advice BEFORE0: #<Interpreted-Function (:ADVICE MATU BEFORE0) C0E4B7>
;>>             Original definition: #<Interpreted-Function (NAMED-LAMBDA MATU (X) (BLOCK MATU (FORMAT T "~&>>~A<<~%" X))) BF7AB7>
;=> NIL

まとめ

 今回は、Lucid CL: Adviceを紹介してみました。
MIT Lispマシン系統とはちょっと違った方式でなかなか面白いです。

Clozure CL: Watched Objectsの紹介

Posted 2014-10-19 09:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の292日目です。

Clozure CL: Watched Objectsとはなにか

 Clozure CL: Watched Objectsは、Clozure CLの標準機能でオブジェクトへの書き込みを監視する機能です。

パッケージ情報

ドキュメントClozure Documentation: 4.12. Watched Objects

インストール方法

 Clozure CLの拡張なので標準で利用可能です。パッケージはCCLパッケージですが、CL-USERでも使えるようになっています。

試してみる

 基本的にどんなLispオブジェクトでも変更を検出できます(クラスのインスタンス等も可)

(defvar *v* (vector 0 1 2 3 4 5))

*v* ;=> #(0 1 2 3 4 5)

(watch *v*) ;=> #(0 1 2 3 4 5)

(incf (svref *v* 3) 10) ;!> Write to watched uvector #(0 1 2 3 4 5) at index 3

 少しわかりにくい監視対象のオブジェクトとしてハッシュテーブルとリストがあります。
ハッシュテーブルは、バックエンドのベクタの書き込みを禁止する方法で実現しているのでエラーが直感的でないことと、リストの場合は、1つのセルを監視対象とする点です。

(defvar *h* (*:plist-hash-table '(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5)))

(watch *h*)

(incf (gethash :a *h*)) ;!> Write to watched uvector #<HASH-TABLE-VECTOR #x7FFFF7FC300D> at index 149

(defvar *L* (list 'car 'cadr 'caddr))

*L* ;=> (CAR CADR CADDR)

(watch *L*)

(setf (car *L*) 0) ;!> Write to the CAR of watched cons cell (CAR CADR CADDR)

(setf (cdr *L*) 0) ;!> Write to the CDR of watched cons cell (CAR CADR CADDR)

(setf (cadr *L*) 1) ;=> 1

*L* ;=> (CAR 1 CADDR)

また、解除には、unwatchを使います。

(unwatch *L*)

まとめ

 今回は、Clozure CL: Watched Objectsを紹介してみました。
Successfull Lispの30章でもwatchのことが取り上げられていました(Successful Lisp - Chapter 30)が、watchがあるのはどうもMCL系統だけみたいですね。
デバッグの時には活躍することもありそうです。

defmethodの&rest引数でダブルディスパッチにaroundメソッドの組み合わせ

Posted 2014-10-18 14:00:00 GMT

defmethodの&rest引数でもディスパッチしたい

 結論からいうと標準のCommon Lispでは無理です(MOPでカスタマイズした総称関数でも使わない限り)が、多重メソッドでないSmalltalkのようなオブジェクト指向システムの、ダブルディスパッチという技が使えます。

(defmethod foo ((x integer) &rest args)
  (cons (list 'integer x)
        (when args
          (apply #'foo args))))

(defmethod foo ((x list) &rest args) (cons (list 'list x) (when args (apply #'foo args))))

(defmethod foo (x &rest args) (cons (list 't x) (when args (apply #'foo args))))

(foo 1 2 3 '() 5 #(1 2 3 4) 1) ;=> ((INTEGER 1) (INTEGER 2) (INTEGER 3) (LIST NIL) (INTEGER 5) (T #(1 2 3 4)))

aroundメソッドを組み合わせてみる

 毎度のwhen argsが面倒臭いと思ったのですが、aroundで検査してやれば良いんじゃないかと思って試してみました。

(defmethod foo :around (x &rest args)
  (when args
    (call-next-method)))

(defmethod foo ((x integer) &rest args) (cons (list 'integer x) (apply #'foo args)))

(defmethod foo ((x list) &rest args) (cons (list 'list x) (apply #'foo args)))

(defmethod foo (x &rest args) (cons (list 't x) (apply #'foo args)))

(foo 1 2 3 '() 5 #(1 2 3 4) 1) ;=> ((INTEGER 1) (INTEGER 2) (INTEGER 3) (LIST NIL) (INTEGER 5) (T #(1 2 3 4)))

割合に良さそうです。

まとめ

 特にこれといったオチもなく

srfi 96の紹介

Posted 2014-10-18 10:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の291日目です。

srfi 96とはなにか

 srfi 96は、Aubrey Jaffer氏によるSLIBを読み込むために必須なものを規定したSRFIです。

パッケージ情報

パッケージ名srfi 96
SRFI 96SRFI 96: SLIB Prerequisites

試してみる

 そもそもSLIBとはなにかというと、Aubrey Jaffer氏により1992年から開発が開始されたライブラリで、Common Lisp風の機能をScheme処理系に提供するところからスタートしたようです。
さて、明示的にライブラリを読み込むという手順でsrfi 96をサポートしているのは、Larceny位のようですが、Larcenyでは、

(require 'srfi-96)

で利用できますが、SLIBが必要になります。
また、(require 'srfi-96)をするのは、slibをrequireするのと同義のようです。
それで行くとGaucheの(use slib)もsrfi 96みたいなものなのでしょうか。

(scheme-implementation-type)
;=> larceny

(scheme-implementation-version) ;=> "0.97"

(scheme-implementation-type) ;=> |STklos|

(scheme-implementation-version) ;=> "1.10"

t ;=> #t

nil ;=> #f ;; STklos (scheme-implementation-type) ;=> |STklos|

(scheme-implementation-version) ;=> "1.10"

というようにCommon Lispで同じみな感じのものが使えるようになります。

まとめ

 今回は、srfi 96を紹介してみました。
STklosが縦棒のエスケープを使うことで思い出したのですが、STklosは、デフォルトでリーダーが小文字に変換するようで、小文字にされないようにするには、縦棒を使うようです。
Common Lispとは変換が逆の動作なのですが、Gaucheでも、オプションに-fcase-fold付きで起動するとこの動作になるようで(Gaucheの最近のバージョンではコマンドラインオプションが効かない?)、この辺りはSTklos由来の動作なのでしょうか。

Older entries (1814 remaining)