Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2010-10-31

マクロを書くのにもSeriesを使う

| 02:18 | マクロを書くのにもSeriesを使う - わだばLisperになる を含むブックマーク はてなブックマーク - マクロを書くのにもSeriesを使う - わだばLisperになる

マクロを書くのにSeriesを使うというのは、なんとなく抵抗があるので、まずはこういうところから馴れて行くことにしました。

ごちゃごちゃしているので有名なONCE-ONLYで実験。

(import 'fare-utils:WITH-GENSYMS)

(defmacro once-only ((&rest vars) &body body)
  (multiple-value-bind (renames temps)
                       (map-fn '(values symbol symbol)
                               (lambda (var name) 
                                 (values `(,name ,var)
                                         ``(,,var ,,name)))
                               (scan vars)
                               (map-fn 'symbol #'gensym))
    `(let ,(collect renames)
       (with-gensyms ,vars
         `(let (,,@(collect temps))
            ,,@body)))))
;; seriesのリーダーマクロを使った場合
(defmacro once-only ((&rest vars) &body body)
  (multiple-value-bind (renames temps)
                       (#2M(lambda (var name) 
                             (values `(,name ,var)
                                     ``(,,var ,,name)))
                           (scan vars)
                           (#Mgensym))
    `(let ,(collect renames)
       (with-gensyms ,vars
         `(let (,,@(collect temps))
            ,,@body)))))
;; 定義
(defmacro square (x)
  (once-only (x)
    `(* ,x ,x)))

;; 動作
(square (incf x))

;; マクロ展開
(LET ((#:G1239221 (INCF X)))
  (* #:G1239221 #:G1239221))

意外にもONCE-ONLYはすっきり書けました。試してみるもんです。

この先一年の年間ドッグフーディング

| 00:51 | この先一年の年間ドッグフーディング - わだばLisperになる を含むブックマーク はてなブックマーク - この先一年の年間ドッグフーディング - わだばLisperになる

先日までは、「コードは大文字で書く」というのを一年間試してみました。

ちなみに、これは特に実りもありませんでしたが、今年は、

「繰り返し構文はSeriesしか使わない」

で行きます。誰得宣言ですが。

Seriesを常用する上で色々と障害はあるのですが、この辺りをどう解決するかを体験してみます。

ということで、githubに自分の拡張ユーティリティを作成してみることにしました。

来年Seriesに対してどういう考えになっているか楽しみです。

2010-10-29

APROGNの実装色々

| 23:53 | APROGNの実装色々 - わだばLisperになる を含むブックマーク はてなブックマーク - APROGNの実装色々 - わだばLisperになる

先日のエントリーでAPROGNというアナフォリックなPROGNを突然定義して使ってみましたが、

(defmacro aprogn% (&body body)
  `(let (it)
     (setq ,@(mapcan (curry #'list 'it)
                     body))
     it))

;; マクロ展開
(aprogn%
  1
  it)
⇒
(LET (IT)
  (SETQ IT 1
        IT IT)
  IT)

みたいな感じでSETQに展開するものでした。

これはこれでOKかなと思いましたが、他にも何パターンか考えてみました。

LETに展開

(defmacro aprogn%% (&body body)
  (if (null body)
      'it
      `(let ((it ,(car body)))
         (aprogn%% ,@(cdr body)))))

;; マクロ展開
(aprogn%%
  1
  2
  3
  it)
⇒
(LET ((IT 1))
  (LET ((IT 2)) 
    (LET ((IT 3))
      (LET ((IT IT)) 
        IT))))

LET*に展開

(defmacro aprogn%%% (&body body)
  `(let* (it
          ,@(mapcar (curry #'list 'it)
              body))
     it))

;; マクロ展開
(aprogn%%%
  1
  2
  3
  it)
⇒
(LET* (IT 
       (IT 1)
       (IT 2)
       (IT 3)
       (IT IT))
  IT)

ITを直前の式で置換

(defmacro aprogn%%%% (&body body)
  (reduce (lambda (ans x)
            (subst ans 'it x :test #'equal))
          body))

;; マクロ展開
(aprogn%%%%
  (write-to-string '([]))
  (ppcre:regex-replace-all "\\[" it "(")
  (ppcre:regex-replace-all "\\]" it ")")
  (read-from-string it))

⇒
(READ-FROM-STRING
 (PPCRE:REGEX-REPLACE-ALL "\\]"
                          (PPCRE:REGEX-REPLACE-ALL "\\[" 
                                                   (WRITE-TO-STRING '([]))
                                                   "(")
                          ")"))

最後のだけ動作が違いますが、やりたいこととしては入れ子を展開することが目的なので、一番あっている気もします。

しかし、これだとPROGNという名前は良くないのかもしれない…。

2010-10-28

KMRCLを眺める(222) XML-TAG-CONTENTS

| 20:21 | KMRCLを眺める(222) XML-TAG-CONTENTS - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(222) XML-TAG-CONTENTS - わだばLisperになる

今回はKMRCLのxml-utils.lispから、XML-TAG-CONTENTSです。

前回眺めた、POSITIONS-XML-TAG-CONTENTSを使ってタグの中身を切り出すものです。

動作は、

(kl::xml-tag-contents "foo" "<foo bar=\"1\">hello</foo>")
;⇒ "hello", 24, ("bar=\"1\"")

定義は、

(defun xml-tag-contents (tag xmlstr &optional (start-xmlstr 0)
                         (end-xmlstr (length xmlstr)))
  "Returns two values: the string between XML start and end tag
and position of character following end tag."
  (multiple-value-bind
      (startpos endpos nextpos attributes)
      (positions-xml-tag-contents tag xmlstr start-xmlstr end-xmlstr)
    (if (and startpos endpos)
        (values (subseq xmlstr startpos endpos) nextpos attributes)
      (values nil nil nil))))

となっています。

2010-10-27

リーダーマクロ使わないで"[]"を"()"として利用できるか

| 22:04 | リーダーマクロ使わないで"[]"を"()"として利用できるか - わだばLisperになる を含むブックマーク はてなブックマーク - リーダーマクロ使わないで"[]"を"()"として利用できるか - わだばLisperになる

ふと、リーダーマクロを使わないで

(with-[] (list [1 2 3 4] [[5] 6 7 8]))
;⇒ ((1 2 3 4) ((5) 6 7 8))

みたいなことができないものかなあと思ったので挑戦してみることにしました。

Common Lisp的には、"["も"]"も括弧としての意味はないので、例えば

(with-[] (list [1 2 3 4] [[5] 6 7 8]))

と書けば、

"(" "with-[]" "(" "list" "[1" "2" "3" "4]" "[[5]" "6" "7" "8]" ")" ")"

という腑分けになります。

これを単純に文字列置換で、"[]"->"()"してやれば良いんじゃないかということで、

;; utility
(defmacro aprogn (&body body)
  `(let (it)
     (setq ,@(mapcan (curry #'list 'it)
                     body))
     it))

(defmacro with-[]% (&body form)
  (aprogn
    (write-to-string form)
    (ppcre:regex-replace-all "\\[" it "(")
    (ppcre:regex-replace-all "\\]" it ")")
    (read-from-string it)
    `(progn ,@it)))

と書いてみました。

実行

(with-[]%
  (let [[x 1] (y 2) (z 3)]
   (list '[[[[[[[[[[8]]]]]]]]]]
         [list x y z]
         "[foo]")))
;⇒ (((((((((((8)))))))))) (1 2 3) "(foo)")

なるほど、文字列置換だけにリテラルの中身まで置換されてしまうのですね。

ということで、面倒なのでやっぱりリーダーに手を入れてみます。

(defmacro with-[] (&body form)
  (let ((*readtable* (copy-readtable)))
    (set-macro-character #\[ 
                         (lambda (stream char)
                           (declare (ignore char))
                           (read-delimited-list #\] stream 'T)))
    (set-macro-character #\] (get-macro-character #\)))
    ;; 
    (aprogn
      (write-to-string form)
      (read-from-string it)
      `(progn ,@it))))

実行

(with-[]
  (let [[x 1] (y 2) (z 3)]
       (list '[[[[[[[[[[x z y]]]]]]]]]]
             [list x y z]
             "[1 2 3]")))
;⇒ (((((((((((X Z Y)))))))))) (1 2 3) "[1 2 3]")

結局リーダーをプログラミングした方が楽でした。

ちなみに、バッククォート記法は残念ながら使えません…。

2010-10-26

Shibuya.lisp Hackathon #1開催

| 21:41 | Shibuya.lisp Hackathon #1開催 - わだばLisperになる を含むブックマーク はてなブックマーク - Shibuya.lisp Hackathon #1開催 - わだばLisperになる

先週の日曜日にShibuya.lispのHackathonが開催されました。

@acotieさん主催のSmiley HackathonにインスパイアされたこのHackathon、無線LAN/電源完備、という日本オラクルさんの素晴しい環境のおかげで好評のうちに終了しました。

会場を提供して頂いた日本オラクルさん、窓口となって頂いた、@ymotongpooさん、主催者の@yshigeruさん、参加者の皆さんありがとうございました。

参加者は、申し込み86名、実際に会場で数えた参加者は52名という感じでした。

運営が思い付きで企画した割には参加者の人に楽しんで頂けたようで良かったです。

全体の流れは、13:00から17:00までは、ひたすらハック、17:00から18:00にかけて発表という感じになりました。

発表内容ですが、

  1. @nitro_idiot
    • PerlのTest::More風のCLテストフレームワーク
  2. @lambda_sakura
    • Common Lisp+SDLで作成しているゲーム(来年完成を目指し販売予定)のデモ
  3. @garaemon
    • Sphinx的なCLのドキュメント生成システム
  4. @Yuumi3
    • iPad上のLisp処理系デモ
  5. @machida
    • Made with secret alien technology パーカー(no title)
  6. @kiwanami
    • deferred.elやskype.elの解説とデモ
  7. @mgiken
    • MongoDB+Arcや、Arc+Vimについて

と結構バラエティーに富んだ内容となりました。

もうちょっと長ければ完成したのに、という声もちらほら聞かれました。

今回でなんとなくの雰囲気は掴めたので、次回開催するときには問題点諸々を改善して開催できたら良いなと思っています。

2010/10/26現在で見付けたShibuya.lisp Hackathon #1感想エントリー

ちなみに、自分がやっていたことですが、運営的に準備が足りなく、いまいち落ちつかないまま、ずるずると時間が過ぎてしまいました。

Hackathonや、テクニカル・トーク運営の準備をするつもりだったのですが…。

2010-10-25

KMRCLを眺める(221) POSITIONS-XML-TAG-CONTENTS

| 20:40 | KMRCLを眺める(221) POSITIONS-XML-TAG-CONTENTS - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(221) POSITIONS-XML-TAG-CONTENTS - わだばLisperになる

今回はKMRCLのxml-utils.lispから、POSITIONS-XML-TAG-CONTENTSです。

定義は、

(defun positions-xml-tag-contents (tag xmlstr &optional (start-xmlstr 0)
                                       (end-xmlstr (length xmlstr)))
  "Returns three values: the start and end positions of contents between
 the xml tags and the position following the close of the end tag."
  (let* ((taglen (length tag)))
    (multiple-value-bind (start attributes)
        (find-start-tag tag taglen xmlstr start-xmlstr end-xmlstr)
      (unless start
        (return-from positions-xml-tag-contents (values nil nil nil nil)))
      (let ((end (find-end-tag tag taglen xmlstr start end-xmlstr)))
        (unless end
          (return-from positions-xml-tag-contents (values nil nil nil nil)))
        (values start end (+ end taglen 3) attributes)))))

となっていますが、前回、前々回に眺めた、FIND-START-TAG、FIND-END-TAGを使ってタグに囲まれた中身の開始と終了の位置を切り出している様子。

最初に開始タグの検出、不備があれば脱出、次に終了タグの検出/脱出、開始/終了タグともに問題なければ位置を多値で返す、という風。

動作は、

(kl::positions-xml-tag-contents "foo" "<foo bar=\"1\">hello</foo>")
;⇒ 13, 18, 24, ("bar=\"1\"")

;; 開始タグ不備
(kl::positions-xml-tag-contents "foo" "foo>hello</foo>")
;⇒ NIL, NIL, NIL, NIL

;; 終了タグ不備
(kl::positions-xml-tag-contents "foo" "<foo>hello</foo")
;⇒ NIL, NIL, NIL, NIL

となっています。

2010-10-23

Perl6の>><<演算子を真似てみる

| 20:21 | Perl6の>><<演算子を真似てみる - わだばLisperになる を含むブックマーク はてなブックマーク - Perl6の>><<演算子を真似てみる - わだばLisperになる

を読んでPerl6では、

(1, 2, 3) >>+<< (10, 20, 30);
#⇒ 11 22 33

みたいなことができることを知りました。

これは見た目は謎ですが、MAPのことだろうということで、早速真似して作ってみました。

(defmacro >> (fn << &rest lists)
  (declare (ignore <<))
  `(mapcar #',fn ,@lists))

<<をQUOTEしないで書きたかったのでマクロで。

これで、

(>> + <<
    '(1 2 3 4)
    '(2 3 4 5)
    '(3 4 5 6))
;⇒ (6 9 12 15)

(>> list <<
    '(1 2 3 4)
    '(2 3 4 5)
    '(3 4 5 6))
;⇒ ((1 1 2) (2 2 3) (3 3 4) (4 4 5))

(>> = <<
    '(1 2 3 4)
    '(2 3 4 5)
    '(3 4 5 6))
;⇒ (NIL NIL NIL NIL)

(>> /= <<
    '(1 2 3 4)
    '(2 3 4 5)
    '(3 4 5 6))
;⇒ (T T T T)

みたいに書けます。

マクロなのでAPPLY #'MAP〜みたいなことができないこともあり、悔しいので意味なく関数だけでなくマクロやスペシャルフォームでも使えるようにしてみます。

(defmacro >> (fn << &rest lists)
  (declare (ignore <<))
  (if (or (special-operator-p fn)
          (macro-function fn))
      (let ((gs (mapcar (lambda (x)
                          (declare (ignore x))
                          (gensym))
                        lists)))
        `(mapcar (lambda (,@gs) (,fn ,@gs))
                 ,@lists))
      `(mapcar #',fn ,@lists)))

動作

(>> and <<
    '(1 2 3 4)
    '(nil 3 4 5)
    '(3 4 5 6))
;⇒ (nil 4 5 6)

しかし、

(>> let <<
    '(((x 1) (y 2) (z 3)))
    '((print x))
    '((print y))
    '((print z)))

のようなものには対応してません…。

また、上記の定義だと>>と<<の間に空白が必要なのですが、>>foo<<と書けるようにするには、ややこしいことをする必要があります(リーダーマクロなど)

(>>and<<
   '(1 2 3 4)
   '(nil 3 4 5)
   '(3 4 5 6))

でも、そんなに見た目も変らないだろうということで放置。

2010-10-22

KMRCLを眺める(220) FIND-END-TAG

| 18:46 | KMRCLを眺める(220) FIND-END-TAG - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(220) FIND-END-TAG - わだばLisperになる

今回はKMRCLのxml-utils.lispから、FIND-END-TAGです。

動作は、

(kmrcl::find-end-tag "foo" 3 "<foo>hello</foo>" 5 16)
;⇒ 10

という感じで前回のFIND-START-TAGの対で終了タグの開始位置を返すものです。

定義は、

(defun find-end-tag (tag taglen xmlstr start end)
  (fast-string-search
   (concatenate 'string "</" tag ">") xmlstr
   (+ taglen 3) start end))

というところ。

簡単に標準の関数で書けば、

(defun find-end-tag (tag taglen xmlstr start end)
  (declare (ignore taglen))
  (search (concatenate 'string "</" tag ">")
          xmlstr
          :start2 start :end2 end ))

というところでしょうか。

2010-10-21

KMRCLを眺める(219) FIND-START-TAG

| 21:16 | KMRCLを眺める(219) FIND-START-TAG - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(219) FIND-START-TAG - わだばLisperになる

今回はKMRCLのxml-utils.lispから、FIND-START-TAGです。

動作は、

(kl::find-start-tag "foo" 3 "1234<foo bar=\"foo\">hello</foo>" 0 30)
;⇒ 19, ("bar=\"foo\"")

という感じですが、タグの中身の開始位置と存在すれば属性を抜き出すもののようです。

以前眺めたstrings.lispの流れからすると最適化された下請け関数と思われます。

実装は最適化のため若干読みにくくなっていますが、ループしながら目的のものを切り出してゆくという感じです

(defun find-start-tag (tag taglen xmlstr start end)
  "Searches for the start of a tag in an xmlstring. Returns STARTPOS ATTRIBUTE-LIST)"
  (declare (simple-string tag xmlstr)
           (fixnum taglen start end)
           (optimize (speed 3) (safety 0) (space 0)))
  (do* ((search-str (concatenate 'string "<" tag))
        (search-len (1+ taglen))
        (bracketpos (fast-string-search search-str xmlstr search-len start end)
                    (fast-string-search search-str xmlstr search-len start end)))
       ((null bracketpos) nil)
    (let* ((endtag (+ bracketpos 1 taglen))
           (char-after-tag (schar xmlstr endtag)))
      (when (or (char= #\> char-after-tag)
                (char= #\space char-after-tag))
        (if (char= #\> char-after-tag)
            (return-from find-start-tag (values (1+ endtag) nil))
            (let ((endbrack (position-char #\> xmlstr (1+ endtag) end)))
              (if endbrack
                  (return-from find-start-tag
                    (values (1+ endbrack)
                            (string-to-list-skip-delimiter
                             (subseq xmlstr endtag endbrack))))
                  (values nil nil)))))
      (setq start endtag))))

2010-10-20

KMRCLを眺める(218) CDATA-STRING

| 22:09 | KMRCLを眺める(218) CDATA-STRING - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(218) CDATA-STRING - わだばLisperになる

processes.lispも眺め終えてしまったので、今回から、xml-utils.lispです。

ということで、今回はKMRCLのxml-utils.lispから、CDATA-STRINGです。

定義は、

(defun cdata-string (str)
  (concatenate 'string "<![CDATA[" str "]]>"))

となっている通り、ずばりCDATAセクションな文字列を簡便に作成するためのものです。

動作は、

(kl::cdata-string "今回のでそれが良くわかったよ>>199感謝")
;⇒ "<![CDATA[今回のでそれが良くわかったよ>>199感謝]]>"

2010-10-19

KMRCLを眺める(217) PROCESS-SLEEP

| 21:12 | KMRCLを眺める(217) PROCESS-SLEEP - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(217) PROCESS-SLEEP - わだばLisperになる

今回はKMRCLのprocesses.lispから、PROCESS-SLEEPです。

普通のSLEEPと何が違うのかなという感じですが、Allegro CLのマニュアルにあるPROCESS-SLEEPを眺める限りでは、マルチプロセス用のSLEEPのようです。

(defun process-sleep (n)
  #+allegro (mp:process-sleep n)
  #-allegro (sleep n))

ということで処理系によっては、SLEEPと変りませんが、一応…

(defun hello-sleep-3 ()
  (loop :repeat 3
        :do (princ "Hello")
            (terpri)
            (kl::process-sleep 3)))

(hello-sleep-3)
;→ Hello
;→ Hello
;→ Hello
;⇒ NIL

2010-10-18

KMRCLを眺める(216) WITH-TIMEOUT

| 20:27 | KMRCLを眺める(216) WITH-TIMEOUT - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(216) WITH-TIMEOUT - わだばLisperになる

今回はKMRCLのprocesses.lispから、WITH-TIMEOUTです。

指定された時間中でボディの中身を実行し、タイムアウトになったら中止する、というものです。

定義は、

(defmacro with-timeout ((seconds) &body body)
  #+allegro
  `(mp:with-timeout (,seconds) ,@body)
  #+cmu
  `(mp:with-timeout (,seconds) ,@body)
  #+sb-thread
  `(sb-ext:with-timeout ,seconds ,@body)
  #+openmcl
  `(ccl:process-wait-with-timeout "waiting"
                                 (* ,seconds ccl:*ticks-per-second*)
                                 #'(lambda ()
                                     ,@body) nil)
  #-(or allegro cmu sb-thread openmcl)
  `(progn ,@body)に
  )

となっています。

Allegro CL等では、

;; Allegro CL
(defvar *out* #. *standard-output*)

(kl::with-timeout (3)
  (loop :for i :from 0
        :do (format *out* "Hello ~D~%" i)
            (sleep 2)))
;→ Hello 0
;→ Hello 1
;⇒ NIL

というように上手く動きますが、SBCLだとTIMEOUTというコンディションを発生させるので、

;; SBCL
(handler-case 
    (kl::with-timeout (3)
      (loop :for i :from 0
            :do (format *out* "Hello ~D~%" i)
                (sleep 2)))
  (sb-ext:timeout () "時既に時間切れ"))
;→ Hello 0
;→ Hello 1
;⇒ "時既に時間切れ"

と書くようです。

これが書かれた当時は、SBCLもAllegro CLのように書けたのか、最初から統一されていないのかは謎です。

2010-10-17

EmacsのBackward Up Listの動きが気に入らない(2)

| 23:48 | EmacsのBackward Up Listの動きが気に入らない(2) - わだばLisperになる を含むブックマーク はてなブックマーク - EmacsのBackward Up Listの動きが気に入らない(2) - わだばLisperになる

昨日のコードだと

(("foo\"''\"\"\"\"((((((\"\"))))))\"\"\"\"\"\"\"\"\"\"\"BARBAZ"))

のような場合に上手く動かないのでちょっと修正。何も考えず直前のダブルクォートを見ていただけだったので、ダブルクォートがエスケープされている場合に意図しない動きになっていました…。

(defun up-list-or-string (&optional arg)
  (interactive "^p")
  (or arg (setq arg 1))
  (let ((inc (if (> arg 0) 1 -1))
        (in-string-p (in-string-p)))
    (cond (in-string-p
           (let* ((in-string-p (char-to-string in-string-p))
                  (p (search-backward in-string-p)))
             (while (string= "\\" (buffer-substring (1- p) p))
               (setq p (search-backward in-string-p))))
           (setq arg (- arg inc))
           nil)
          ('T (while (/= arg 0)
                (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
                (setq arg (- arg inc)))))))

2010-10-16

EmacsのBackward Up Listの動きが気に入らない

| 22:30 | EmacsのBackward Up Listの動きが気に入らない - わだばLisperになる を含むブックマーク はてなブックマーク - EmacsのBackward Up Listの動きが気に入らない - わだばLisperになる

自分は、EmacsではLISPコード編集に限らずS式編集のキーバインドを良く使う程、S式編集のキーバインドが好きなのですが、backward-up-listの動きがどうも気に入りません。

具体的には、文字列の上で実行するとエラーになってしまうのが気に入らないポイントです。

LispマシンのエディタだったZmacs(Zwei)では、文字列の上で実行すると両端のダブルクォートを括弧と見做したような動きになります。

こっちの方が快適なのでこの動きをデフォルトにしてみたいところ。

とりあえず、Zweiはどうやっているのかソースを眺めてみることにしてみました。

(DEFCOM COM-BACKWARD-UP-LIST "Move up one level of list structure, backward.
Also, if called inside of a string, moves back up out of that string." (KM)
  (LET ((BP (IF (LISP-BP-SYNTACTIC-CONTEXT (POINT))
                (FORWARD-UP-STRING (POINT) (NOT (MINUSP *NUMERIC-ARG*)))
                (FORWARD-SEXP (POINT) (- *NUMERIC-ARG*) NIL 1))))
    (OR BP (BARF))
    (MOVE-BP (POINT) BP))
  DIS-BPS)

あまり良く分かりませんが、関数の名前からすると、どうやら括弧だけでなく、ポイントが文字列の上にあった場合のことも考えていたようです。

Emacsの実装ですが、

(defun backward-up-list (&optional arg)
  "Move backward out of one level of parentheses.
With ARG, do this that many times.
A negative argument means move forward but still to a less deep spot.
This command assumes point is not in a string or comment."
  (interactive "^p")
  (up-list (- (or arg 1))))

(defun up-list (&optional arg)
  "Move forward out of one level of parentheses.
With ARG, do this that many times.
A negative argument means move backward but still to a less deep spot.
This command assumes point is not in a string or comment."
  (interactive "^p")
  (or arg (setq arg 1))
  (let ((inc (if (> arg 0) 1 -1)))
    (while (/= arg 0)
      (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
      (setq arg (- arg inc)))))

のようになっています。

これをちょっと改造して、ポイントが文字列中にあった場合にも対応してみました

(defun zwei-backward-up-list (&optional arg)
  "Move up one level of list structure, backward.
Also, if called inside of a string, moves back up out of that string."
  (interactive "^p")
  (up-list-or-string (- (or arg 1))))

(defun up-list-or-string (&optional arg)
  (interactive "^p")
  (or arg (setq arg 1))
  (let ((inc (if (> arg 0) 1 -1))
        (in-string-p (in-string-p)))
    (cond (in-string-p
           (search-backward (char-to-string in-string-p))
           (setq arg (- arg inc))
           nil)
          ('T (while (/= arg 0)
                (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
                (setq arg (- arg inc)))))))

(define-key global-map [(control meta ?u)] 'zwei-backward-up-list)

モードによって依然としてエラーになりますが、プログラミングモード以外は文字列というものがないようなので、これはこれで良いかなということで放置。

割と快適になりました。

各Emacs系エディタでのBackward Up Listの動作

他のエディタはどういう風になっているのかなということで無駄に調べてみました

エディタ文字列中で実行された場合の動作
GNU Emacs括弧の対応でエラー
Xyzzy括弧の対応でエラー
オリジナル Emacs(tecoの実装)じっとして動かない
LispWorksのエディタじっとして動かない
Zwei/Zmacsダブルクォートの先頭に移動する
Allegro CLのIDEのエディタダブルクォートは無視して外の括弧へ飛ぶ
Hemlock/CMUCLダブルクォートは無視して外の括弧へ飛ぶ

どうも3種類位のバリエーションがあるようですね。

個人的にはやはりZweiの動きが一番好きです。

2010-10-15

KMRCLを眺める(215) WITH-LOCK-HELD

| 23:45 | KMRCLを眺める(215) WITH-LOCK-HELD - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(215) WITH-LOCK-HELD - わだばLisperになる

今回はKMRCLのprocesses.lispから、WITH-LOCK-HELDです。

ボディの中身が指定したロックが有効になった状態で実行されるというものです。

定義は、

(defmacro with-lock-held ((lock) &body body)
  #+allegro
  `(mp:with-process-lock (,lock) ,@body)
  #+cmu
  `(mp:with-lock-held (,lock) ,@body)
  #+lispworks
  `(mp:with-lock (,lock) ,@body)
  #+sb-thread
  `(sb-thread:with-recursive-lock (,lock) ,@body)
  #+openmcl
  `(ccl:with-lock-grabbed (,lock) ,@body)
  #-(or allegro cmu lispworks sb-thread openmcl)
  `(progn ,@body)
  )

となっています。

命名については、各処理系で割とばらばらですが、KMRCLでは今回もCMUCLに沿っているようです。

動作は、前回と同じ例ですが、

(defvar *out* #.*standard-output*)

;; ロックなし
(let ((x 0))
  (defun inc ()
    (print x *out*)
    (sleep (/ (random 8) 10))
    (incf x)))

;; ロックあり
(let ((lock (kl::make-lock "inc"))
      (x 0))
  (defun inc-with-lock ()
    (kl::with-lock-held (lock)
      (print x *out*)
      (sleep (/ (random 8) 10))
      (incf x))))

;; ロックなし
(dotimes (i 10)
  (kl::make-process (string (gensym)) 
                    #'inc))
;→
0 
0 
0 
0 
0 
0 
1 
1 
1
;⇒ NIL

;; ロックあり with-lock-held+mutex 
(dotimes (i 10)
  (kl::make-process (string (gensym)) 
                    #'inc-with-lock))
;→
0 
1 
2 
3 
4 
5 
6 
7 
8 
9
;⇒ NIL

というところ

2010-10-14

KMRCLを眺める(214) MAKE-LOCK

| 23:50 | KMRCLを眺める(214) MAKE-LOCK - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(214) MAKE-LOCK - わだばLisperになる

今回はKMRCLのprocesses.lispから、MAKE-LOCKです。

定義は、

(defun make-lock (name)
  #+allegro (mp:make-process-lock :name name)
  #+cmu (mp:make-lock name)
  #+lispworks (mp:make-lock :name name)
  #+sb-thread (sb-thread:make-mutex :name name)
  #+openmcl (ccl:make-lock name)
  )

となっていて、各処理系のlockのラッパーになっています。やはり命名は、CMUCL方式の様子。

動作は、

(kl::make-lock "foo")
;⇒ #S(SB-THREAD:MUTEX :NAME "foo" :%OWNER NIL :STATE 0)
;; lockなし
(let ((x 0))
  (defun inc ()
    (print x)
    (sleep (/ (random 8) 10))
    (incf x)))

;; lock付き
(let ((lock (kl::make-lock "inc"))
      (x 0))
  (defun inc-with-lock ()
    (sb-thread:with-mutex (lock)
      (print x)
      (sleep (/ (random 8) 10))
      (incf x))))

;; lockなし
(loop :repeat 10
      :do (kl::make-process 
           (string (gensym))
           (lambda (&aux (*standard-output* #.*standard-output*))
             (inc))))
;->
0 
0 
0 
0 
0 
0 
1 
1 
1
;⇒ NIL

;; lock使用
(loop :repeat 10
      :do (kl::make-process
           (string (gensym))
           (lambda (&aux (*standard-output* #.*standard-output*))
             (inc-with-lock))))
;->
0 
1 
2 
3 
4 
5 
6 
7 
8 
9
;⇒ NIL

というところでしょうか。あまり定番の書き方が分かってないですが…。

2010-10-13

KMRCLを眺める(213) DESTROY-PROCESS

| 23:03 | KMRCLを眺める(213) DESTROY-PROCESS - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(213) DESTROY-PROCESS - わだばLisperになる

今回はKMRCLprocesses.lispから、DESTROY-PROCESSです。

定義は、

(defun destroy-process (process)
  #+cmu (mp:destroy-process process)
  #+allegro (mp:process-kill process)
  #+sb-thread (sb-thread:destroy-thread process)
  #+lispworks (mp:process-kill process)
  #+openmcl (ccl:process-kill process)
  )

となっていてスレッドを殺す関数のラッパーです。やはり命名はCMUCLに合せているようです。

眺めてみるにPROCESS-KILLという名前も定番のようですね。

動作は、SBCLべったりですが、

(kl::make-process "sleep 999"
                  (lambda () (sleep 999)))
;⇒ #<SB-THREAD:THREAD "sleep 999" RUNNING {1011CDDC61}>

(sb-thread:list-all-threads)
;⇒ (#<SB-THREAD:THREAD "worker" RUNNING {1011DEC001}>
;    #<SB-THREAD:THREAD "sleep 999" RUNNING {1011CDDC61}>
;    #<SB-THREAD:THREAD "repl-thread" RUNNING {1011A9DE91}>
;    #<SB-THREAD:THREAD "auto-flush-thread" RUNNING {1011A9DC21}>
;    #<SB-THREAD:THREAD "reader-thread" RUNNING {1011425161}>
;    #<SB-THREAD:THREAD "control-thread" RUNNING {1011423EE1}>
;    #<SB-THREAD:THREAD "Swank 4005" RUNNING {101132EDF1}>
;    #<SB-THREAD:THREAD "initial thread" RUNNING {10110E3BB1}>)

(find "sleep 999"
      (sb-thread:list-all-threads)
      :test #'string=
      :key #'sb-thread:thread-name)
;⇒ #<SB-THREAD:THREAD "sleep 999" RUNNING {1011C24351}>

;; スレッドを名前で見付けてDESTROY-PROCESS
(kl::destroy-process  
 (find "sleep 999"
       (sb-thread:list-all-threads)
       :test #'string=
       :key #'sb-thread:thread-name))
;⇒ NIL

(sb-thread:list-all-threads)
;⇒ (#<SB-THREAD:THREAD "worker" RUNNING {1011EEE271}>
;    #<SB-THREAD:THREAD "repl-thread" RUNNING {1011A9DE91}>
;    #<SB-THREAD:THREAD "auto-flush-thread" RUNNING {1011A9DC21}>
;    #<SB-THREAD:THREAD "reader-thread" RUNNING {1011425161}>
;    #<SB-THREAD:THREAD "control-thread" RUNNING {1011423EE1}>
;    #<SB-THREAD:THREAD "Swank 4005" RUNNING {101132EDF1}>
;    #<SB-THREAD:THREAD "initial thread" RUNNING {10110E3BB1}>)

というところ。

2010-10-12

KMRCLを眺める(212) MAKE-PROCESS

| 23:24 | KMRCLを眺める(212) MAKE-PROCESS - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(212) MAKE-PROCESS - わだばLisperになる

console.lispも眺め終えたので、今回からKMRCLのprocesses.lispを眺めます。

processes.lisp処理系依存のマルチスレッド/プロセス系関数のラッパーを集めたもののようです。

ということで、今回は、make-processです。

定義は、

(defun make-process (name func)
  #+allegro (mp:process-run-function name func)
  #+cmu (mp:make-process func :name name)
  #+lispworks (mp:process-run-function name nil func)
  #+sb-thread (sb-thread:make-thread func :name name)
  #+openmcl (ccl:process-run-function name func)
  #-(or allegro cmu lispworks sb-thread openmcl) (funcall func)
  )

となっていますが、命名はどうやらCMUCLに合せた様子。

PROCESS-RUN-FUNCTIONという名前も多いようですが、CLでは処理系依存なものでも大体同じ名前とインターフェイスで提供されていることが多い気がします。

過去に同様の機能をLispマシン等が提供していた場合は、それを踏襲することも多いようです。

動作は、

(kl::make-process "hello" 
                  (lambda (&aux (*standard-output* #.*standard-output*))
                    (print "hello!")))
;→ "hello!" 
;⇒ #<SB-THREAD:THREAD "hello" FINISHED values: "hello!" {1011C39CC1}>

というところ。

2010-10-10

(48) Lisp のプログラミング環境 (<大特集>新しいプログラミング環境)

| 23:27 | (48) Lisp のプログラミング環境 (新しいプログラミング環境) - わだばLisperになる を含むブックマーク はてなブックマーク - (48) Lisp のプログラミング環境 (新しいプログラミング環境) - わだばLisperになる

これまで紹介したもののなかにも論文の体裁ではないようなものがありましたが、CiNiiでは、情報処理学会の会誌「情報処理」の内容も無料で読めるようになっていて、その特集だったようです。

どちらにせよ面白い内容なので良いのですが、こういうのは文献といって紹介した方が良いのでしょうか。

今回は、

です。

情報処理 Vol. 30 No.4

は、プログラミング環境の特集のようですが、この特集では、LISPのプログラミング環境として、SymbolicsのGeneraと、XeroxのInterlisp-Dの当時の二大Lispマシンの環境を紹介しています。

かなり詳しく紹介されているのですが、現在のEmacs上の環境であるSLIMEより便利そうなところが散見され、やはり羨しいなあと思ってしまいます。

一度、これらのLispマシンの環境にどっぷりとつかってみたいものです。

2010-10-09

Quicklisp素晴しい!

| 16:02 | Quicklisp素晴しい! - わだばLisperになる を含むブックマーク はてなブックマーク - Quicklisp素晴しい! - わだばLisperになる

Quicklispは、Common Lispのライブラリ導入システムです。

構想が発表されたときには、clbuildや、asdf-install、中止されたmudball等々沢山あるのに、更にまた来るのか、と思いましたが、Quicklispはこれらのシステムの抱える問題を解決する狙いもあるようです。

主なところだと、

  • Windowsを含めてのOSのマルチプラットフォーム対応
  • ライブラリの依存関係の解消(バージョンの問題も含む)
  • ライブラリの配布先のサイトがダウンしておりインストールできない問題の解消

等々があるようです。

詳しくは、ウェブサイト、デモ動画で知ることができます。

Quicklispはこれまで、開発者のZach Beane氏に直接連絡して、ダウンロードできるURLを教えてもらうという方法でテストを行なってきたようですが、今日、Beta版として公開されました。

ということで、早速導入。

難しいところは全然無く、

の通りにすればOKです。

まず、

$ wget http://beta.quicklisp.org/quicklisp.lisp

等として、quicklisp.lispをダウンロード、これを処理系に読み込ませて、

(quicklisp-quickstart:install)

すれば、導入完了。

あとは、

(ql:quickload "ライブラリ名")

などで好きなライブラリを導入。自動でダウンロードしてきてセットアップしてくれます。

ライブラリを探すには、

(ql:system-apropos "ライブラリ名")

のようにして探せます。

自分は、デモ動画の通り、weblocksを導入してみましたが、ちょっと待っているだけで、weblocksを起動するところまで行き着くのは、やはり便利だと思いました。

今後、機能が充実/安定してゆけば標準的なものになって行きそう。

ライブラリ管理の決定版になると良いですね!

CLISPでの例

; SLIME 2010-10-01
CL-USER> (load "/share/sys/cl/src/quicklisp.lisp")
;; Loading file /share/sys/cl/src/quicklisp.lisp ...

  ==== quicklisp quickstart loaded ====

    To continue, evaluate: (quicklisp-quickstart:install)

;; Loaded file /share/sys/cl/src/quicklisp.lisp
T
CL-USER> (quicklisp-quickstart:install)
; Fetching #<URL "http://beta.quicklisp.org/quickstart/asdf.lisp">
; 144.48KB
==================================================
147,949 bytes in 1.26 seconds (114.92KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/quickstart/quicklisp.tar">
; 160.00KB
==================================================
163,840 bytes in 1.48 seconds (108.43KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/quickstart/setup.lisp">
; 2.78KB
==================================================
2,846 bytes in 0.01 seconds (235.97KB/sec)

; Fetching #<URL "http://beta.quicklisp.org/dist/quicklisp.txt">
; 0.40KB
==================================================
408 bytes in 0.02 seconds (23.12KB/sec)

  ==== quicklisp installed ====

    To load a system, use: (ql:quickload "system-name")

    To find systems, use: (ql:system-apropos "term")

    To load Quicklisp every time you start Lisp, use: (ql:add-to-init-file)

    For more information, see http://www.quicklisp.org/beta/

NIL
CL-USER> ; No value
CL-USER> (ql:system-apropos "kmrcl")
; Fetching #<URL "http://beta.quicklisp.org/dist/quicklisp/2010-10-07/systems.txt">
; 45.30KB
==================================================
46,386 bytes in 0.42 seconds (107.16KB/sec)
; Fetching #<URL "http://beta.quicklisp.org/dist/quicklisp/2010-10-07/releases.txt">
; 83.49KB
==================================================
85,490 bytes in 0.60 seconds (140.01KB/sec)
#<SYSTEM kmrcl / kmrcl-20101006-git / quicklisp 2010-10-07>
#<SYSTEM kmrcl-tests / kmrcl-20101006-git / quicklisp 2010-10-07>
NIL
CL-USER> (ql:quickload "kmrcl")
To load "kmrcl":
  Install 1 Quicklisp release:
    kmrcl
; Fetching #<URL "http://beta.quicklisp.org/archive/kmrcl/2010-10-06/kmrcl-20101006-git.tgz">
; 54.66KB
==================================================
55,973 bytes in 0.56 seconds (97.24KB/sec)
; Loading "kmrcl"
[package kmrcl]...................................
[package kmr-mop]..
("kmrcl")
CL-USER> (kl:cmsg "Hello, Quicklisp!")
;; Hello, Quicklisp!
NIL
CL-USER> 

2010-10-07

KMRCLを眺める(211) FIXME

| 20:33 | KMRCLを眺める(211) FIXME - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(211) FIXME - わだばLisperになる

今回は、KMRCLのconsole.lispからFIXMEです。

FIXMEやXXXはコメントの中でお馴染ですが、そのFIXMEを(ログに)出力するもののようです。

定義はこれまでの、CMSG等と同じ感じで

(defun fixme (template &rest args)
  "Format output to console"
  (setq template (concatenate 'string "~&;; ** FIXME ** " template "~%"))
  (apply #'format t template args)
  (values))

となっています。

動作は

(kl:fixme "now")
;→ ;; ** FIXME ** now

といったところ。

なんでもCLで書いてるとこういうのも必要になってくるんでしょうね。

2010-10-05

SLIMEばつ牛ン (2) slime-apropos

| 13:00 | SLIMEばつ牛ン (2) slime-apropos - わだばLisperになる を含むブックマーク はてなブックマーク - SLIMEばつ牛ン (2) slime-apropos - わだばLisperになる

SLIMEのコマンドを確認していくシリーズ、今回は、 slime-apropos です。

キーバインド

デフォルトのキーバインドは、c-c c-d c-aもしくは、c-c c-d c-z

最後のc-aと、c-zの違いですが、aの方は、EXPORTされているシンボルのみで、zの方は、すべてのシンボルを対象にします。

使い方

M-x slime-apropos

を実行すると、探したいシンボルの名前を訊かれますので、入力します。(名前の一部でもOKです)

SLIME Apropos: foo
CL-MARKDOWN:FOOTNOTE
  Function: (not documented)
CL-MARKDOWN:FOOTNOTES
  Function: (not documented)
COM.INFORMATIMAGO.COMMON-LISP.HTML:TFOOT
  Macro: (not documented)
COM.INFORMATIMAGO.COMMON-LISP.HTML:TFOOT*
  Function: (not documented)
COM.INFORMATIMAGO.COMMON-LISP.HTRANS:GENERATE-HTML-FOOTER
  Generic Function: A hook allowing the hprogram to display a footer.

という風に候補がでます。

自分はこのslime-aproposで使えそうな関数を探すために可能な限りのパッケージ詰め込んだコアを作成して使っていたりします。

定義は、

(defun slime-apropos (string &optional only-external-p package 
                             case-sensitive-p)
  "Show all bound symbols whose names match STRING. With prefix
arg, you're interactively asked for parameters of the search."
  (interactive
   (if current-prefix-arg
       (list (read-string "SLIME Apropos: ")
             (y-or-n-p "External symbols only? ")
             (let ((pkg (slime-read-package-name "Package: ")))
               (if (string= pkg "") nil pkg))
             (y-or-n-p "Case-sensitive? "))
     (list (read-string "SLIME Apropos: ") t nil nil)))
  (let ((buffer-package (or package (slime-current-package))))
    (slime-eval-async
     `(swank:apropos-list-for-emacs ,string ,only-external-p
                                    ,case-sensitive-p ',package)
     (slime-rcurry #'slime-show-apropos string buffer-package
                   (slime-apropos-summary string case-sensitive-p
                                          package only-external-p)))))

となっています。

定義を眺めていて知ったのですが、数引数を付けるとオプションを全部対話的に処理することができるようです。

指定できるオプションは、

  • 外部シンボルのみかどうか
  • 指定したパッケージ内部で探す
  • 大文字小文字を区別するかどうか

自分は、c-c c-d c-zを知らなかったので、ちょっと不便だなと思っていたのですが、ちゃんと用意されていたんですね。

2010-10-04

KMRCLを眺める(210) CMSG-REMOVE

| 23:30 | KMRCLを眺める(210) CMSG-REMOVE - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(210) CMSG-REMOVE - わだばLisperになる

今回は、KMRCLのconsole.lispからCMSG-REMOVEです。

前回のCMSG-ADDの逆で、*CONSOLE-MSGS-TYPES*から指定したものを登録を削除するもの

(defun cmsg-remove (condition)
  (setf *console-msgs-types* (remove condition *console-msgs-types*)))

動作は、

kl::*console-msgs-types*
;⇒ (:DEBUG)

(kl:cmsg-remove :debug)
;=> NIL

kl::*console-msgs-types*
;=> NIL

というところ。

elispを書く時なども、こういう風にインターフェイスを考えてみると書いたりすると良いLISP入門になるかもと思いました。

;; elisp
(add-to-list "foo/bar/baz" 'load-path)

ではなく、

(pushnew-load-path "foo/bar/baz")

にしてみるとか。…あまりピンとくる例にもなってないですね。

2010-10-03

KMRCLを眺める(209) CMSG-ADD

| 00:02 | KMRCLを眺める(209) CMSG-ADD - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(209) CMSG-ADD - わだばLisperになる

今回は、KMRCLのconsole.lispからCMSG-ADDです。

前回のCMSG-Cでは、*CONSOLE-MSGS-TYPES*にメッセージを出力する状況のタイプをリストで格納していましたが、そのリストを操作するための関数のようです。

*CONSOLE-MSGS-TYPES*を直接SETQやPUSHしたりはせず、インターフェイスを設けるということですね。

(defun cmsg-add (condition)
  (pushnew condition *console-msgs-types*))

動作は、

kl::*console-msgs-types*
;=> NIL

(kl:cmsg-add :debug)
;=> (:DEBUG)

というところ。

2010-10-01

KMRCLを眺める(208) CMSG-C

| 23:36 | KMRCLを眺める(208) CMSG-C - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(208) CMSG-C - わだばLisperになる

今回は、KMRCLのconsole.lispからCMSG-Cです。

前回のCMSGを一捻りしたもののようで定義は、

(defvar *console-msgs-types* nil)

(defun cmsg-c (condition template &rest args)
  "Push CONDITION keywords into *console-msgs-types* to print console msgs
   for that CONDITION.  TEMPLATE and ARGS function identically to
   (format t TEMPLATE ARGS) "
  (when (or (member :verbose *console-msgs-types*)
            (member condition *console-msgs-types*))
    (apply #'cmsg template args)))

となっていて、*CONSOLE-MSGS-TYPES*にメッセージを出力する状況のタイプをリストで格納して置いて、CMSG-Cの引数にそのタイプが指定されていた場合は、出力、そうでなければスルーというもののようです。

動作は、

(let ((kl::*console-msgs-types* '(:debug)))
  (kl:cmsg-c :debug "~37@{*~}" t)
  (kl:cmsg-c :debug "~37:@<~A~>" "蟲取り")
  (kl:cmsg-c :debug "~37@{*~}" t))
;=> NIL
;->
;; *************************************
;;                  蟲取り                 
;; *************************************

というところ。

:verboseは予め組込まれています。

しかし、なんとなく微妙な使い勝手に感じました…。

ちなみに、FORMATの引数の"~37@{*~}"というのは、@t33fさんに教えて頂きました。ありがとうございます!