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 |

2009-11-29

KMRCLを眺める (26) deflex

| 19:00 | KMRCLを眺める (26) deflex - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (26) deflex - わだばLisperになる

今回は、KMRCLのmacros.lispの中からDEFLEXです。

Common Lispにはグローバルな(トップレベルの)レキシカル変数というものがないのですが、DEFLEXは、それの動きを模倣するためのマクロです。

From USENETとなっていますが、調べてみるとRob Warnockさん作のようです。

;; From USENET
(defmacro deflex (var val &optional (doc nil docp))
  "Defines a top level (global) lexical VAR with initial value VAL,
      which is assigned unconditionally as with DEFPARAMETER. If a DOC
      string is provided, it is attached to both the name |VAR| and the
      name *STORAGE-FOR-DEFLEX-VAR-|VAR|* as a documentation string of
      kind 'VARIABLE. The new VAR will have lexical scope and thus may
      be shadowed by LET bindings without affecting its global value."
  (let* ((s0 (load-time-value (symbol-name '#:*storage-for-deflex-var-)))
         (s1 (symbol-name var))
         (p1 (symbol-package var))
         (s2 (load-time-value (symbol-name '#:*)))
         (backing-var (intern (concatenate 'string s0 s1 s2) p1)))
    `(progn
      (defparameter ,backing-var ,val ,@(when docp `(,doc)))
      ,@(when docp
              `((setf (documentation ',var 'variable) ,doc)))
      (define-symbol-macro ,var ,backing-var))))

という定義で分かるように、*STORAGE-FOR-DEFLEX-VAR-|VAR|*の値をシンボルマクロで包んでいますが、シンボルマクロで包むのと包まないのでは、

(DEFLEX /FOO/ 33) ;*STORAGE-FOR-DEFLEX-VAR-/FOO/*も33

(LET ((FN (LET ((/FOO/ 44))
            (LAMBDA ()
              /FOO/))))
  (LET ((/FOO/ 55))
    (FUNCALL FN)))
;⇒ 44

(LET ((FN (LET ((*STORAGE-FOR-DEFLEX-VAR-/FOO/* 44))
            (LAMBDA () *STORAGE-FOR-DEFLEX-VAR-/FOO/*))))
  (LET ((*STORAGE-FOR-DEFLEX-VAR-/FOO/* 55))
    (FUNCALL FN)))
;⇒ 55

のように動作が変わってきます。

ところで、

(load-time-value (symbol-name '#:*storage-for-deflex-var-))

という風にLOAD-TIME-VALUEしている意図が分からないのですが、理由が分かる方是非とも教えてください。

普通に

(intern (concatenate 'string "*STORAGE-FOR-DEFLEX-VAR-" s1 "*") p1)

じゃ駄目なんでしょうか…。

2009-11-28

KMRCLを眺める (25) mv-bind

| 21:28 | KMRCLを眺める (25) mv-bind - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (25) mv-bind - わだばLisperになる

今回は、KMRCLのmacros.lispの中からMB-BINDです。

定義は、こんな感じですが、

(defmacro mv-bind (vars form &body body)
  `(multiple-value-bind ,vars ,form
     ,@body))

明らかにMULTIPLE-VALUE-BINDと打つのが面倒もしくは名前短かくしてソース読みやすくしたい、的なマクロです。

自分はslimeだとmvbindと打ってCtrl-Meta-Iで補完してMULTIPLE-VALUE-BINDと入力しているのですが、候補にMV-BINDが引っ掛かってきて逆に迷惑です(笑)

脱線しますが、MULTIPLE-VALUE-BINDには天下のPG(ポール・グレアム)もbindという名前を付けてたみたいです。

(defmacro bind (&rest args)
  `(multiple-value-bind ,@args))

さらに、まったくどうでも良いことなのですが、MULTIPLE-VALUE-BINDがなんでbindまで短かくなるのか疑問です。しかし、S式だった頃のDylanを眺めてみるとbindという名前でMULTIPLE-VALUE-BINDの様な構文を提供していたので、もしかしてここから来てるのかなあと想像してます。(他にもDylan由来の関数を色々紹介してたりするので…)

KMRCLを眺める (24) time-iterations

| 01:30 | KMRCLを眺める (24) time-iterations - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (24) time-iterations - わだばLisperになる

今日は、KMRCLのmacros.lispの中からTIME-ITERATIONSです。

TIME-ITERATIONSは、ボディ部が任意の回数繰り返されるTIMEマクロ、というところで

定義は、こんな感じです。

(defmacro time-iterations (n &body body)
  (let ((i (gensym))
        (count (gensym)))
    `(progn
       (let ((,count ,n))
         (format t "~&Test with ~d iterations: ~W" ,count (quote ,body))
         (let ((t1 (get-internal-real-time)))
           (dotimes (,i ,count)
             ,@body)
           (let* ((t2 (get-internal-real-time))
                  (secs (coerce (/ (- t2 t1)
                                   internal-time-units-per-second)
                                'double-float)))
             (format t "~&Total time: ")
             (print-seconds secs)
             (format t ", time per iteration: ")
             (print-seconds (coerce (/ secs ,n) 'double-float))))))))

使い方は、

(TIME-ITERATIONS 10
  (DOTIMES (I 1000000)
    (+ 1 1)))
Test with 10 iterations: ((DOTIMES (I 1000000) (+ 1 1)))
Total time: 10.61 sec, time per iteration: 1.06 sec
;⇒ NIL

(TIME-ITERATIONS 10
  (DOTIMES (I 1000000)
    (eval '(+ 1 1))))
Test with 10 iterations: ((DOTIMES (I 1000000) (EVAL '(+ 1 1))))
Total time: 15.55 sec, time per iteration: 1.56 sec
;⇒ NIL

という感じでしょうか。

こういうユーティリティをみるとslimeと連携させてみたくなるのですが、いつもの雛形をちょっといじって

;; Emacs lisp
(eval-after-load "slime"
  '(progn
     (defun slime-time-iterations (times)
       (interactive "p")
       (slime-eval-and-time-iterations
        `(swank:eval-and-grab-output
          ,(format "(kmrcl:time-iterations %s %s)" 
                   times
                   (slime-defun-at-point)))))
     
     (defun slime-eval-and-time-iterations (form)
       (slime-eval-async form (slime-rcurry #'slime-show-time-iterations
                                            (slime-current-package))))
     
     (defun slime-show-time-iterations (string package)
       (slime-with-popup-buffer ("*SLIME TIME-ITERATIONS*" package t t)
         (lisp-mode)
         (princ (first string))
         (goto-char (point-min))))
     
     ;; SUPER-SHIFT-T
     (define-key slime-mode-map
       [(super shift ?t)] 'slime-time-iterations)))

というのを作ってみました。

任意の式の上で、C-u 10 Super-Shift-Tすると、別バッファに10回繰り返された結果が表示されるのですが、あまり便利でもありません…。

ちなみに、このパターンはslimeを拡張するときに自分内では頻出するのでEmacs lispでマクロを書きたいところです。

2009-11-26

KMRCLを眺める (23) time-seconds

| 23:26 | KMRCLを眺める (23) time-seconds - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (23) time-seconds - わだばLisperになる

今日は、KMRCLのmacros.lispの中からTIME-SECONDSです。

定義は、こんな感じで、

(defmacro time-seconds (&body body)
  (let ((t1 (gensym)))
    `(let ((,t1 (get-internal-real-time)))
       (values
        (progn ,@body)
        (coerce (/ (- (get-internal-real-time) ,t1)
                   internal-time-units-per-second)
                'double-float)))))

BODYの結果と実行時間を多値で返してくれるというものみたいです。

(DEFUN FIB (N)
  (COND ((< N 2) N)
        ('T (+ (FIB (1- N))
               (FIB (- N 2))))))

(TIME-SECONDS 
  (FIB 40))
;=> 102334155
;   3.089d0

どういうときに使えるのかいまいち想像できず、絶対にやらなそうな例しか考えつきませんでした…。

;; FIB-AとFIB-Bの速度を比較して、速い方にFIBという名前をつける

(DEFUN FIB-A (N)
  (COND ((< N 2) N)
        ('T (+ (FIB (1- N))
               (FIB (- N 2))))))

(DEFUN FIB-B (N)
  (DECLARE (FIXNUM N))
  (COND ((< N 2) N)
        ('T (+ (FIB (1- N))
               (FIB (- N 2))))))

(SETF (SYMBOL-FUNCTION 'FIB)
      (LET ((VAL 40))
        (MULTIPLE-VALUE-BIND (A A-TIME) (TIME-SECONDS (FIB-A VAL))
          (MULTIPLE-VALUE-BIND (B B-TIME) (TIME-SECONDS (FIB-B VAL))
            (OR (= A B) (ERROR))
            (IF (< A-TIME B-TIME)
                #'FIB-A
                #'FIB-B)))))
;=> #<Function FIB-B>

2009-11-25

KMRCLを眺める (22) with-gensyms

| 23:26 | KMRCLを眺める (22) with-gensyms - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (22) with-gensyms - わだばLisperになる

今日は、KMRCLのmacros.lispの中からWITH-GENSYMSです。

WITH-GENSYMSは、標準のCLに含まれていないマクロでは有名なものの一つではないでしょうか。

これもOn Lisp由来だったと思います。

使われ方は、

(DEFMACRO MY-LOOP (&BODY BODY)
  (WITH-GENSYMS (TOP)
    `(BLOCK NIL
       (TAGBODY 
        ,TOP
          ,@BODY
          (GO ,TOP)))))

という感じでしょうか。

単に、LETとGENSYMの組み合わせで書けば良いのですが、GENSYMする変数が多くなると確かに便利です。

定義は、

(defmacro with-gensyms (syms &body body)
  `(let ,(mapcar #'(lambda (s) `(,s (gensym)))
          syms)
     ,@body))

という感じで、これもやりたいことそのままな定義ですね。

WITH-GENSYMSは、色々なライブラリに含まれていることが多いのですが、WITH-UNIQUE-NAMESという名前で含まれていることが多いようです。確かにWITH-UNIQUE-NAMESの方が説明的な名前ではあります。

Arcでも、w/uniqという、WITH-UNIQUE-NAMES的な名前で含まれています。

2009-11-24

KMRCLを眺める (21) mean

| 01:07 | KMRCLを眺める (21) mean - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (21) mean - わだばLisperになる

今日は、KMRCLのmacros.lispの中からMEANです。

これもポール・グレアム氏由来マクロだったような気がしますが、どこに書いてあったか忘れてしまいました。

使われ方は、

(MEAN 1 2 3 4 5 6 7 8 9)
;⇒ 5

という感じで、上記は、

(/ (+ 1 2 3 4 5 6 7 8 9) 9)

と展開されるのでリストの長さを求めるコストをマクロ展開時(大体コンパイル前)にずらせるので実行時は効率的だ、とか、引数のコンス節約だ、とかいう感じでしょうか。

マクロ定義は、

(defmacro mean (&rest args)
  `(/ (+ ,@args) ,(length args)))

というそのままのものです。

CLを触っていると、リード時、マクロ展開時、ロード時、コンパイル時、実行時、等々色々なタイミングでどう評価されるのかを考える機会が増えてややこしい気がするんですが、各々のタイミングで色々いじれるのが楽しいのもまた事実です☺

2009-11-23

KMRCLを眺める (20) in

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

今日は、KMRCLのmacros.lispの中からINです。

これは、On Lisp由来のマクロだと思われます。

使われ方は、

(IN 1 1 2 3 4 5)
;⇒ T

という感じでしょうか。

最初の要素がそれ以降の要素群に存在した場合にTになるというもので、MEMBERに比べてコンシングを減らせるというのが特長のようです。

定義は、

(defmacro in (obj &rest choices)
  (let ((insym (gensym)))
    `(let ((,insym ,obj))
       (or ,@(mapcar #'(lambda (c) `(eql ,insym ,c))
                     choices)))))

という感じで

(IN 1 1 2 3 4 5)

;%>>>
(LET ((#:G89595 1))
  (OR (EQL #:G89595 1)
      (EQL #:G89595 2)
      (EQL #:G89595 3)
      (EQL #:G89595 4)
      (EQL #:G89595 5)))

のようにEQLの連鎖に展開されます。

2009-11-22

KMRCLを眺める (19) with-each-file-line

| 19:26 | KMRCLを眺める (19) with-each-file-line - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (19) with-each-file-line - わだばLisperになる

今日は、KMRCLのmacros.lispの中からWITH-EACH-FILE-LINEです。

定義は、

(defmacro with-each-file-line ((var file) &body body)
  (let ((stream (gensym)))
    `(with-open-file (,stream ,file :direction :input)
      (with-each-stream-line (,var ,stream)
        ,@body))))

というもので、前回のWITH-EACH-STREAM-LINEにファイルを開く指定を被せたものです。

使用例は、

(WITH-OUTPUT-TO-STRING (OUT)
  (LET ((LINE-NUM 0))
    (WITH-EACH-FILE-LINE (LINE "/etc/motd")
      (FORMAT OUT "~4D: ~A~%" (INCF LINE-NUM) LINE))))
;⇒
"   1: Linux setq 2.6.31-14-generic #48-Ubuntu SMP Fri Oct 16 14:05:01 UTC 2009 x86_64
   2: 
   3: To access official Ubuntu documentation, please visit:
   4: http://help.ubuntu.com/
"

みたいな感じでしょうか。

実は自分は、最初に

(WITH-EACH-FILE-LINE (LINE "/etc/motd")
  (WITH-OUTPUT-TO-STRING (OUT)
    (LET ((LINE-NUM 0))
      (FORMAT OUT "~4D: ~A~%" (INCF LINE-NUM) LINE))))
;⇒ NIL

と書いて若干はまりました。

原因はマクロ展開するとすぐに分かるのですが、

(WITH-OPEN-FILE (#:G2727 "/etc/motd" :DIRECTION :INPUT)
  (LET ((#:G2730 #:G2727) (#:G2728 '#:G2729))
    (DO ((LINE (READ-LINE #:G2730 NIL #:G2728) (READ-LINE #:G2730 NIL #:G2728)))
        ((EQL LINE #:G2728))
      (WITH-OUTPUT-TO-STRING (OUT)
        (LET ((LINE-NUM 0))
          (FORMAT OUT "~4D: ~A~%" (INCF LINE-NUM) LINE))))))

となるのでこのマクロでは入れ子の順番が大事ということになります。

どうもWITH-というマクロで入れ子の順番を気にしないといけないというマクロはあまりないので、WITH-EACH-FILE-LINEという名前よりは、DO-FILE-LINESとかの方が良いんじゃないかと思いました。

(WITH-OUTPUT-TO-STRING (OUT)
  (LET ((LINE-NUM 0))
    (DO-FILE-LINES (LINE "/etc/motd")
      (FORMAT OUT "~4D: ~A~%" (INCF LINE-NUM) LINE))))

という方が明確な気がしますし、

(DO-FILE-LINES (LINE "/etc/motd")
  (WITH-OUTPUT-TO-STRING (OUT)
    (LET ((LINE-NUM 0))
      (FORMAT OUT "~4D: ~A~%" (INCF LINE-NUM) LINE))))

これはぱっと見ただけで何か勘違いがあるんじゃないかと、なんとなく分かります。(WITH-EACH-を見て勘がすぐに働けば問題ないのですが…)

それとWITH-OPEN-FILEに渡すキーが:DIRECTIONだけなのも使い勝手が良くなかったので拡張してみました。

(DEFMACRO DO-FILE-LINES ((VAR FILE &REST KEYS &KEY &ALLOW-OTHER-KEYS) &BODY BODY)
  (LET ((STREAM (GENSYM))
        (KEYS (COPY-LIST KEYS)))
    (REMF KEYS :DIRECTION)
    `(WITH-OPEN-FILE (,STREAM ,FILE :DIRECTION :INPUT ,@KEYS)
       (WITH-EACH-STREAM-LINE (,VAR ,STREAM)
         ,@BODY))))

こういう場合のKEYの書き方の定番ってどういうのが良いのかいまいち分かりませんが、とりあえずで書いています。(横着しないでDO-FILE-LINESの仮引数のところで丁寧に全部書くべきなのかも)

2009-11-21

KMRCLを眺める (18) with-each-stream-line

| 15:59 | KMRCLを眺める (18) with-each-stream-line - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (18) with-each-stream-line - わだばLisperになる

今日は、KMRCLのmacros.lispの中からWITH-EACH-STREAM-LINEです。

定義は、

(defmacro with-each-stream-line ((var stream) &body body)
  (let ((eof (gensym))
        (eof-value (gensym))
        (strm (gensym)))
    `(let ((,strm ,stream)
           (,eof ',eof-value))
      (do ((,var (read-line ,strm nil ,eof) (read-line ,strm nil ,eof)))
          ((eql ,var ,eof))
        ,@body))))

というもので、ストリームをREAD-LINEする部分をまとめたもののようです。

確かに頻出するパターンなのでマクロにすると便利だなと思いました。

使われ方としては、

(WITH-INPUT-FROM-STRING (IN
                         "Linux setq 2.6.31-14-generic #48-Ubuntu SMP Fri Oct 16 14:05:01 UTC 2009 x86_64

To access official Ubuntu documentation, please visit:
http://help.ubuntu.com/")
    (WITH-OUTPUT-TO-STRING (OUT)
      (LET ((LINE-NUM 0))
        (WITH-EACH-STREAM-LINE (LINE IN)
          (FORMAT OUT "~4D: ~A~%" (INCF LINE-NUM) LINE)))))
;⇒
"   1: Linux setq 2.6.31-14-generic #48-Ubuntu SMP Fri Oct 16 14:05:01 UTC 2009 x86_64
   2: 
   3: To access official Ubuntu documentation, please visit:
   4: http://help.ubuntu.com/
"

みたいな感じでしょうか。

地味に良いマクロだと思いました。

2009-11-20

KMRCLを眺める (17) for

| 23:53 | KMRCLを眺める (17) for - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (17) for - わだばLisperになる

今日は、KMRCLのmacros.lispの中からFORです。

forという名前からしてCなどのforを真似てみたのかと思いきや、眺める限りではどうも、

(LOOP :FOR X :FROM 0 :TO 100 
      :DO ...)

のようなものを簡潔に書くためのマクロのようです。

使用例としては、

(WITH-NREVERSE (ANS)
  (FOR (X 1 50)
    (PUSH X ANS)))
;⇒ (1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
;    30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50)

という感じでしょうか。

WITH-NREVERSEってなんだという感じですが、FORの周りがごちゃごちゃしないようにマクロにまとめてみました。

(DEFMACRO WITH-NREVERSE ((&REST VARS) &BODY BODY)
  `(LET (,@VARS)
     ,@BODY
     (VALUES ,@(MAPCAR (LAMBDA (X) `(NREVERSE ,X)) VARS))))

のようなものを考えていますが、余計わかりにくかったかもしれません…。

DOTIMESだと0から開始なので、開始を指定できるというのが地味に使いどころはありそうです。

FORの定義は、

(defmacro for ((var start stop) &body body)
  (let ((gstop (gensym)))
    `(do ((,var ,start (1+ ,var))
          (,gstop ,stop))
         ((> ,var ,gstop))
       ,@body)))

のような感じです。値増加のステップも指定できませんし非常にシンプルなものです。

2009-11-19

KMRCLを眺める (16) while

| 23:49 | KMRCLを眺める (16) while - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (16) while - わだばLisperになる

今日は、KMRCLのmacros.lispの中からWHILEです。

WHILEにについては、AWHILEのときに書いてしまったのですが、Emacs Lisp/XyzzyにあってCLにない代表的なマクロかと思います。

使用例としては、

(WITH-OPEN-FILE (IN "/etc/motd")
  (LET (LINE ANS)
    (WHILE (SETQ LINE (READ-LINE IN NIL NIL))
      (PUSH LINE ANS))
    (NREVERSE ANS)))
;⇒ ("Linux setq 2.6.31-14-generic #48-Ubuntu SMP Fri Oct 16 14:05:01 UTC 2009 x86_64"
; "" "To access official Ubuntu documentation, please visit:"
; "http://help.ubuntu.com/")

こんな感じでしょうか。

定義は、

(defmacro while (test &body body)
  `(do ()
       ((not ,test))
     ,@body))

みたいな感じです。

CLの人からはあまり「WHILE欲しいなあ」という声は聞かないのですが、多分似たようなことは、LOOPで簡潔に書けてしまうからではないかと想像しています。

上のWHILEの例は、

(WITH-OPEN-FILE (IN "/etc/motd")
  (LOOP :FOR LINE := (READ-LINE IN NIL NIL) :WHILE LINE
        :COLLECT LINE))
;⇒ ("Linux setq 2.6.31-14-generic #48-Ubuntu SMP Fri Oct 16 14:05:01 UTC 2009 x86_64"
; "" "To access official Ubuntu documentation, please visit:"
; "http://help.ubuntu.com/")

のように書けます。

2009-11-17

KMRCLを眺める (15) until

| 22:21 | KMRCLを眺める (15) until - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (15) until - わだばLisperになる

今日は、KMRCLのmacros.lispの中からUNTILです。

今回のUNTILからしばらくループ系のマクロが続きます。

UNTILの良い例が思い付かないので例のための例ですが、

(WITH-OPEN-FILE (IN "/etc/motd")
  (LET (LINE ANS)
    (UNTIL (EQ :EOF (SETQ LINE (READ-LINE IN NIL :EOF)))
      (PUSH LINE ANS))
    (NREVERSE ANS)))
;⇒ ("Linux setq 2.6.31-14-generic #48-Ubuntu SMP Fri Oct 16 14:05:01 UTC 2009 x86_64"
;   "" "To access official Ubuntu documentation, please visit:"
;   "http://help.ubuntu.com/")

という風に述語がTを返すまでのループを繰り返します。

;;; Loop macros

(defmacro until (test &body body)
  `(do ()
       (,test)
     ,@body))

ちなみに、WHILEと同じくUNTILもCLにはありませんが、このマクロ定義で分かるように、DOはUNTIL系のループです。

UNTILにLETを合体させて変数を更新するようにしたものがDOともいえるでしょうか。

;; DO
(DO ((I 0 (1+ I)))
    ((> I 10))
  (PRINC I))
;⇒ NIL
----------
012345678910

;; UNTIL
(LET ((I 0))
  (UNTIL (> I 10)
    (PRINC I)
    (INCF I)))
;⇒ NIL
----------
012345678910

2009-11-16

KMRCLを眺める (14) print-form-and-results

| 00:01 | KMRCLを眺める (14) print-form-and-results - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (14) print-form-and-results - わだばLisperになる

今日は、KMRCLのmacros.lispの中からPRINT-FORM-AND-RESULTSです。

これも前回のMACに引き続き便利ユーティリティのようです。EXPORTされてませんので、使う時は適宜EXPORTしましょう。

使い方は、REPLなどで、

(print-form-and-results
  (DOSEQUENCES* ((I '(1 2 3 4 5 6 7)) (S "12341234123412341234" NIL :START 2))
    (PRINT (LIST I S))))
;=> (1 #\3) 
;   (2 #\4) 
;   (3 #\1) 
;   (4 #\2) 
;   (5 #\3) 
;   (6 #\4) 
;   (7 #\1) 
;   (DOSEQUENCES* ((I '(1 2 3 4 5 6 7)) (S "12341234123412341234" NIL :START 2))
;     (PRINT (LIST I S))) --> NIL

という感じでしょうか。フォームをプリントして、-->の後に返り値をプリントしています。

定義は、

(defmacro print-form-and-results (form)
  `(format t "~&~A --> ~S~%" (write-to-string ',form) ,form))

という感じです。やりたいことそのままですね。

なんとなくSLIMEと連携して表示させてみたらどうかと思い、

;; Emacs Lisp
(eval-after-load "slime"
  '(progn
     (defun slime-print-form-and-results ()
       "(Print-Form-And-Results) the form at point."
       (interactive)
       (slime-eval-and-print-form-and-results
        `(swank:eval-and-grab-output
          ,(format "(kmrcl::print-form-and-results %s)" (slime-defun-at-point)))))
     
     (defun slime-eval-and-print-form-and-results (form)
       "Print-Form-And-Results FORM in Lisp and display the result in a new buffer."
       (slime-eval-async form (slime-rcurry #'slime-show-print-form-and-results
                                            (slime-current-package))))
     
     (defun slime-show-print-form-and-results (string package)
       (slime-with-popup-buffer ("*SLIME Print-Form-And-Results*" package t t)
         (lisp-mode)
         (princ (first string))
         (goto-char (point-min))))
     
     ;; control-shift-r
     (define-key slime-mode-map
       [(control shift ?r)] 'slime-print-form-and-results)))

というのを定義してみました。

(DOSEQUENCES* ((I '(1 2 3 4 5 6 7)) (S "12341234123412341234" NIL :START 2))
  (PRINT (LIST I S)))

の上で、C-sh-Rすると、

(1 #\3) 
(2 #\4) 
(3 #\1) 
(4 #\2) 
(5 #\3) 
(6 #\4) 
(7 #\1) 
(DOSEQUENCES* ((I '(1 2 3 4 5 6 7)) (S "12341234123412341234" NIL :START 2))
  (PRINT (LIST I S))) --> NIL

のように別のフレームで表示されますが、表示がちょっと中途半端ですね。

もう少し手をかけて整形して表示すると良いかもしれません。

2009-11-14

KMRCLを眺める (13) mac

| 23:21 | KMRCLを眺める (13) mac - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (13) mac - わだばLisperになる

今日は、KMRCLのmacros.lispの中からMACです。

アナフォリック・マクロシリーズも前回で終わりました。

今回のMACはマクロを展開して表示してくれる便利ユーティリティのようです。

使い方は、REPLなどで、

(mac (loop :for i :from 100 :downto 0))
;⇒ (BLOCK NIL
;    (LET ((I 100))
;      (DECLARE (TYPE (AND REAL NUMBER) I))
;      (SB-LOOP::LOOP-BODY NIL
;                          (NIL NIL (WHEN (< I '0) (GO SB-LOOP::END-LOOP))
;                           NIL)
;                          NIL
;                          (NIL (SB-LOOP::LOOP-REALLY-DESETQ I (1- I))
;                           (WHEN (< I '0) (GO SB-LOOP::END-LOOP)) NIL)
;                          NIL)))
;  

という感じでしょうか。

定義は、MACROEXPAND-1をした結果をCL標準のPPRINT(プリティ・プリント)で表示しているようです。

(defmacro mac (expr)
"Expand a macro"
  `(pprint (macroexpand-1 ',expr)))

REPLでMACROEXPAND-1を連発してるスタイルの方には便利かもしれません。

Slimeを使っている人はエディタバッファでslime-macroexpand-〜できるので不要ですね。

KMRCLを眺める (12) acond2

| 03:04 | KMRCLを眺める (12) acond2 - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (12) acond2 - わだばLisperになる

今日は、KMRCLのmacros.lispの中からACOND2です。

名前の通りAIF2のCOND版です。述語部で2値を処理できるし、SchemeのSRFI-61の拡張condようなことができるかも、と思いちょっとコード例を考えてみましたが、良く良く考えるとSRFI-61とは全然別ものでした。SRFI-61便利ですね。しょうがないので

(LET ((HT (MAKE-HASH-TABLE)))
  (SETF (GETHASH :BAR HT) NIL
        (GETHASH :BAZ HT) NIL)
  
  (ACOND2 ((GETHASH :FOO HT) (LIST :FOO IT))
          ((GETHASH :BAR HT) (LIST :BAR IT))
          ((GETHASH :BAZ HT) (LIST :BAZ IT))
          ('T :NOT-FOUND)))
;=> (:BAR NIL)

というものを無理矢理考えてみました。

ACOND2の定義はこんな感じです。

(defmacro acond2 (&rest clauses)
  (if (null clauses)
      nil
      (let ((cl1 (car clauses))
            (val (gensym))
            (win (gensym)))
        `(multiple-value-bind (,val ,win) ,(car cl1)
           (if (or ,val ,win)
               (let ((it ,val)) ,@(cdr cl1))
               (acond2 ,@(cdr clauses)))))))

これまで紹介したアナフォリック・マクロが全部合体したような感じですね。

ACOND2の話には全く関係ないのですが、CONDでは述部の返り値が式の返り値になる場合があるというのは以前ACONDのときに書きました。

(COND (:FOO))
;=> :FOO

のような場合ですが、こういうパターンで述語が多値を返す場合はどうなるかというと、

(COND ((VALUES :FOO :BAR)))
;=> :FOO

1番目の値しか返らないと仕様で決まっています。

CONDは詳しく眺めると色々とややこしいところがある気がします。

この述語の多値問題については、上述のSRFI-61は多値も扱えるようになっていて便利ですね。

2009-11-11

KMRCLを眺める (11) awhile2

| 22:37 | KMRCLを眺める (11) awhile2 - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (11) awhile2 - わだばLisperになる

今日は、KMRCLのmacros.lispの中からAWHILE2です。

これもEXPORTされてないようなので、使う時にはEXPORTしましょう。

AIF2のWHILE版なのですが、どこで使えるか例を考えるのが大変です。

ハッシュテーブルから見付かっている間だけループを回すという

(DEFPARAMETER *HT* (CH-UTIL:MAKE-HASH-TABLE-FROM-PLIST (ALEXANDRIA:IOTA 20)))

(LET ((KEY 0))
  (AWHILE2 (GETHASH (INCF KEY 2) *HT*)
    (PRINT (LIST :KEY KEY :VAL IT))))
;=> NIL
----------
;⇒(:KEY 2 :VAL 3) 
;  (:KEY 4 :VAL 5) 
;  (:KEY 6 :VAL 7) 
;  (:KEY 8 :VAL 9) 
;  (:KEY 10 :VAL 11) 
;  (:KEY 12 :VAL 13) 
;  (:KEY 14 :VAL 15) 
;  (:KEY 16 :VAL 17) 
;  (:KEY 18 :VAL 19) 

というものを無理矢理こじつけてみましたが、こんな局面はほぼないですし、あったとしてもAWHILE2は使わない気が。

定義はこんな感じです。

(defmacro awhile2 (test &body body)
  (let ((flag (gensym)))
    `(let ((,flag t))
       (while ,flag
         (aif2 ,test
               (progn ,@body)
               (setq ,flag nil))))))

AIF2系統がEXPORTされてない理由もなんとなく分かってきた気がします…。

2009-11-10

KMRCLを眺める (10) awhen2

| 01:04 | KMRCLを眺める (10) awhen2 - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (10) awhen2 - わだばLisperになる

今日は、KMRCLのmacros.lispの中からAWHEN2です。

これもAIF2と同じくEXPORTされてないようなので、使う時にはEXPORTしましょう。

名前を見て分かるように、AIF2のWHEN版です。

AIF2より使いどころがなさそう。使用例もいまいち思い付きません…。

(LET ((HT (MAKE-HASH-TABLE)))
  (SYMBOL-MACROLET ((HT-FOO (GETHASH :FOO HT)))
    (SETF HT-FOO NIL)
    
    (AWHEN2 HT-FOO
      (SETF HT-FOO (LIST 42 IT))

    HT-FOO))
;⇒ (42 NIL)
;   T

定義は前回のAIF2を下敷きにしています。

(defmacro awhen2 (test &body body)
  `(aif2 ,test
         (progn ,@body)))

LISPイメージにとにかくなんでも入れて置くと便利

| 22:46 | LISPイメージにとにかくなんでも入れて置くと便利 - わだばLisperになる を含むブックマーク はてなブックマーク - LISPイメージにとにかくなんでも入れて置くと便利 - わだばLisperになる

今日Twitterで「CLで(Tue Nov 10 05:15:05 +0000 2009)のような日付をパーズするライブラリを探している」というつぶやきを見付けました。

自分はこういう場合にはどうやって目的のものを探すかというと、

  1. とりあえず、slime-apropos(C-c C-d a)する
  2. キーワードは、パーズということなので、parse
  3. 自分は、手元のパッケージをあるだけ詰め込んだイメージを常用しているので、沢山引っ掛かってくる
  4. 一覧が表示されるので、そこからdate等で絞り込む。
  5. METABANG.UTILITIES:PARSE-DATE-AND-TIMEがそれっぽい名前なので試してみる
  6. エラーになるのでこの書式には対応おらず駄目らしい
  7. NET.TELENT.DATE:PARSE-TIMEはどうか
  8. (DATE:PARSE-TIME "Tue Nov 10 05:15:05 +0000 2009") ;⇒ 3466818905
  9. これで行けるらしい

という風にイメージの中から適当に探しています。

イメージの中から探すには、読み込めるだけ全部のライブラリを読みこんである方が有利なのですが、こうやって探せるのが便利なので可能な限り多くのパッケージを読み込んでダンプしています。

イメージの作成方法は、処理系によって違うと思いますが、大抵の処理系でダンプできます。

自分が今使っているSBCLのパッケージを調べてみましたが、お蔭でなんだか良く分からないものまで300位パッケージがあります…。

  1. ACL-COMPAT-SYSTEM
  2. ACL-COMPAT.EXCL
  3. ACL-COMPAT.MP (ACL-COMPAT-MP ACL-MP)
  4. ACL-COMPAT.SOCKET (ACL-SOCKET SOCKET)
  5. ACL-COMPAT.SYSTEM (ACL-COMPAT.SYS)
  6. ALEXANDRIA.0.DEV (ALEXANDRIA)
  7. ANAPHORA
  8. ANAPHORA-BASIC
  9. ANAPHORA-SYMBOL
  10. ARC-COMPAT-ASD
  11. ARC-COMPAT.SETAGAYA.MC (ARC)
  12. ARTIFICIAL-FLAVORS (AF)
  13. ASDF
  14. ASDF-ADDITIONS
  15. ASDF-ADDITIONS-SYSTEM
  16. ASDF-CACHE
  17. ASDF-INSTALL
  18. ASDF-INSTALL-CUSTOMIZE
  19. ASDF-INSTALL-SYSTEM
  20. ASDF-MOPTILITIES
  21. ASDF-SYSTEM-CONNECTIONS
  22. ASERVE-SYSTEM
  23. ASPECTL (AL)
  24. ASPECTL-USER (AL-USER)
  25. ASPECTL.CLOS-MOP (AL.CLOS-MOP)
  26. ASPECTL.DYNACLOS (AL.DYNACLOS)
  27. ASPECTL.DYNASCOPE (AL.DYNASCOPE)
  28. ASPECTL.DYNASCOPE.SPECIAL-SYMBOLS
  29. ASPECTL.MIXINS (AL.MIXINS)
  30. ASPECTL.POINTCUTS (AL.POINTCUTS)
  31. BABEL
  32. BABEL-ENCODINGS
  33. BORDEAUX-THREADS (BT)
  34. BORDEAUX-THREADS-SYSTEM
  35. BPM
  36. BPM.PRETTIFY
  37. BPM.SYSTEM
  38. CFFI
  39. CFFI-FEATURES
  40. CFFI-SYS
  41. CFFI-UTIL
  42. CFFI-UTIL-SYSTEM
  43. CHUNGA
  44. CL+
  45. CL+SSL
  46. CL+SSL-SYSTEM
  47. CL-AA-SYSTEM
  48. CL-BASE64 (BASE64)
  49. CL-BASE64-SYSTEM
  50. CL-CONT (CONT)
  51. CL-CONT-ASD
  52. CL-DEF
  53. CL-DEF.SYSTEM
  54. CL-FAD (FAD)
  55. CL-FAD-TEST
  56. CL-GLFW (GLFW)
  57. CL-GLFW-SYSTEM
  58. CL-GLFW-TYPES
  59. CL-GLFW-TYPES-SYSTEM
  60. CL-INTERPOL (INTERPOL)
  61. CL-INTERPOL-ASD
  62. CL-MATCH
  63. CL-NCURSES
  64. CL-NCURSES-ASD
  65. CL-PATHS-SYSTEM
  66. CL-PPCRE (PPCRE)
  67. CL-PPCRE-ASD
  68. CL-PREVALENCE
  69. CL-SERIALIZER (SERIALIZER)
  70. CL-SERIALIZER-SYSTEM
  71. CL-STM (STM)
  72. CL-STM.SYSTEM
  73. CL-UNICODE
  74. CL-UNICODE-ASD
  75. CL-UNICODE-NAMES
  76. CL-UTILITIES
  77. CL-UTILITIES-SYSTEM
  78. CL-VECTORS-SYSTEM
  79. CL.EXT.DACF.UNIFICATION (UNIFY)
  80. CLEX
  81. CLOSER-COMMON-LISP (C2CL)
  82. CLOSER-COMMON-LISP-USER (C2CL-USER)
  83. CLOSER-MOP (C2MOP)
  84. CLOSURE-COMMON-SYSTEM
  85. CLOSURE-HTML (CHTML)
  86. CLOSURE-MIME-TYPES
  87. CLOSURE-SYSTEM
  88. CLRFI-1
  89. CLX-SYSTEM
  90. COMMON-IDIOMS
  91. COMMON-IDIOMS-SYSTEM
  92. COMMON-LISP (CL)
  93. COMMON-LISP-USER (CL-USER)
  94. CONTAINERS-SYSTEM
  95. CONTEXTL
  96. CONTEXTL-COMMON-LISP (CXCL)
  97. CONTEXTL-USER (CX-USER)
  98. CORBIT
  99. CXML
  100. CXML-STP (STP)
  101. CXML-STP-IMPL
  102. CXML-STP-SYSTEM
  103. CXML-SYSTEM
  104. CXML-XMLS
  105. DATE-CALC
  106. DATE-CALC.SYSTEM
  107. DE.DATAHEAVEN.CHUNKED-STREAM-MIXIN
  108. DIFFLIB
  109. DNSBL
  110. DNSBL-COMPAT-ASD
  111. DOM
  112. DOMTEST
  113. DOMTEST-TESTS
  114. DPMS
  115. DRAKMA
  116. DRAKMA-ASD
  117. EDITOR-HINTS.NAMED-READTABLES (NAMED-READTABLES)
  118. FARE-CLOS-MATCH
  119. FARE-MATCHER
  120. FARE-MATCHER-EXTENSIONS (MATCH-EXTS)
  121. FARE-QUASIQUOTE
  122. FARE-UTILS
  123. FLEXI-STREAMS (FLEX)
  124. FLEXI-STREAMS-SYSTEM
  125. GL
  126. GLX
  127. GRAY-STREAM
  128. GSLL (GSL)
  129. HAX
  130. HTML-GLISP
  131. HTMLGEN-SYSTEM
  132. HUNCHENTOOT (TBNL)
  133. HUNCHENTOOT-ASD
  134. HW
  135. IO.ENCODINGS (IOENC)
  136. IO.ENCODINGS.SYSTEM
  137. IO.MULTIPLEX (IOMUX)
  138. IO.MULTIPLEX-SYSTEM
  139. IO.STREAMS
  140. IO.STREAMS.SYSTEM
  141. IOLIB
  142. IOLIB-ALIEN-GROVEL
  143. IOLIB-ALIEN-GROVEL-SYSTEM
  144. IOLIB-POSIX (ET)
  145. IOLIB-POSIX-SYSTEM
  146. IOLIB-UTILS
  147. IOLIB-UTILS-MISC.SYSTEM
  148. IOLIB-UTILS-PACKAGE.SYSTEM
  149. IOLIB-UTILS-SYMBOLS.SYSTEM
  150. IOLIB.BASE
  151. IT.BESE.ARNESI (ARNESI)
  152. IT.BESE.ARNESI.MOPP (MOPP)
  153. IT.BESE.ARNESI.MOPP%INTERNALS
  154. IT.BESE.ARNESI.SYSTEM
  155. IT.BESE.FIVEAM (FIVEAM 5AM)
  156. IT.BESE.FIVEAM.SYSTEM
  157. ITERATE (ITER)
  158. JP
  159. JSON
  160. JSON-RPC
  161. JSON-SYSTEM
  162. KEYWORD
  163. KLACKS
  164. KMR-MOP
  165. KMRCL (KL)
  166. KMRCL-SYSTEM
  167. KOTO.ICONV (ICONV)
  168. LALR
  169. LISP-MARKUP-LANGUAGE-2 (LML2)
  170. LISP-UNIT
  171. LISP-UNIT-SYSTEM
  172. LISPWORKS
  173. LML2-SYSTEM
  174. LML2-TESTS-SYSTEM
  175. LOCAL-TIME
  176. LOCAL-TIME.SYSTEM
  177. MATCH
  178. MBE
  179. MD5
  180. MD5-SYSTEM
  181. MECAB
  182. METABANG.BIND (METABANG-BIND BIND)
  183. METABANG.BIND-SYSTEM
  184. METABANG.CL-CONTAINERS (CONTAINERS CL-CONTAINERS)
  185. METABANG.MOPTILITIES (MOPTILITIES MOPU)
  186. METABANG.UTILITIES (METATILITIES)
  187. METATILITIES-BASE-SYSTEM
  188. METATILITIES-SYSTEM
  189. MKCORE
  190. MYCL-UTIL
  191. MYCL-UTIL-SYSTEM
  192. NET-TELENT-DATE-SYSTEM
  193. NET.ASERVE
  194. NET.ASERVE.CLIENT
  195. NET.HTML.GENERATOR
  196. NET.NTUNIOTT.CL.EXT.SYNTAX.DEFINER (DEFINER CL.EXT.SYNTAX.DEFINER)
  197. NET.SOCKETS (SOCKETS)
  198. NET.SOCKETS-SYSTEM
  199. NET.TELENT.DATE (DATE)
  200. NET.TUXEE.AA (AA)
  201. NET.TUXEE.AA-BIN (AA-BIN)
  202. NET.TUXEE.PATHS (PATHS)
  203. NET.TUXEE.VECTORS (VECTORS)
  204. ORG.MAPCAR.PARSE-NUMBER (PARSE-NUMBER)
  205. OSICAT
  206. OSICAT-SYSTEM
  207. PARENSCRIPT (PS JS)
  208. PARENSCRIPT.SYSTEM
  209. PARSE-NUMBER-SYSTEM
  210. PORTABLE-THREADS
  211. PORTABLE-THREADS-SYSTEM
  212. PREGEXP
  213. PRIMORDIAL
  214. PURI (NET.URI)
  215. PURI-SYSTEM
  216. REDSHANK (CLEE)
  217. REGRESSION-TEST (RT RTEST)
  218. RFC2388
  219. RFC2388.SYSTEM
  220. RUNE-DOM (CXML-DOM)
  221. RUNES
  222. RUNES-ENCODING
  223. S-SERIALIZATION
  224. S-SYSDEPS
  225. S-XML
  226. SALZA2
  227. SAX
  228. SB-ACLREPL
  229. SB-ACLREPL-SYSTEM
  230. SB-ALIEN (SB-C-CALL)
  231. SB-ALIEN-INTERNALS
  232. SB-ASSEM
  233. SB-BIGNUM
  234. SB-BSD-SOCKETS
  235. SB-BSD-SOCKETS-INTERNAL (SOCKINT)
  236. SB-BSD-SOCKETS-SYSTEM
  237. SB-C
  238. SB-CLTL2
  239. SB-CLTL2-SYSTEM
  240. SB-DEBUG
  241. SB-DI
  242. SB-DISASSEM
  243. SB-EVAL
  244. SB-EXECUTABLE
  245. SB-EXT
  246. SB-FASL
  247. SB-FORMAT
  248. SB-GRAY
  249. SB-GROVEL
  250. SB-GROVEL-SYSTEM
  251. SB-IMPL
  252. SB-INT
  253. SB-INTROSPECT
  254. SB-INTROSPECT-SYSTEM
  255. SB-KERNEL
  256. SB-LOOP
  257. SB-MD5
  258. SB-MD5-SYSTEM
  259. SB-MOP
  260. SB-PCL
  261. SB-POSIX
  262. SB-POSIX-SYSTEM
  263. SB-PRETTY
  264. SB-PROFILE
  265. SB-ROTATE-BYTE
  266. SB-ROTATE-BYTE-SYSTEM
  267. SB-RT
  268. SB-RT-SYSTEM
  269. SB-SEQUENCE (SEQUENCE)
  270. SB-SIMPLE-STREAM-SYSTEM
  271. SB-SIMPLE-STREAMS
  272. SB-SPROF
  273. SB-SYS
  274. SB-THREAD
  275. SB-UNIX
  276. SB-VM
  277. SB-WALKER
  278. SCREAMER
  279. SCREAMER-SYSTEM
  280. SCREAMER-USER
  281. SCREAMS
  282. SERIES
  283. SERIES-SYSTEM
  284. SGML
  285. SPLIT-SEQUENCE (PARTITION)
  286. SPLIT-SEQUENCE-SYSTEM
  287. SRFI.SETAGAYA.MC (SRFI)
  288. STANDARD-CL (STD)
  289. SWANK
  290. SWANK-BACKEND
  291. SWANK-IO-PACKAGE
  292. SWANK-LOADER
  293. SWANK-MATCH
  294. SWANK-MOP
  295. TAO-COMPAT-ASD
  296. TAO-COMPAT.SETAGAYA.MC (TAO-COMPAT)
  297. TOADSTOOL
  298. TOADSTOOL-IMPL
  299. TOADSTOOL-SYSTEM
  300. TOADSTOOL-UTILS
  301. TRIVIAL-GARBAGE (TG)
  302. TRIVIAL-GRAY-STREAMS
  303. TRIVIAL-GRAY-STREAMS-SYSTEM
  304. UFFI
  305. UFFI-SYSTEM
  306. URL-REWRITE
  307. USOCKET
  308. USOCKET-SYSTEM
  309. UTF8-RUNES
  310. VECTO
  311. XLIB
  312. XML (XML)
  313. XMLCONF
  314. XPATH
  315. XPATH-PROTOCOL
  316. XPATH-SYS
  317. XPATH.SYSTEM
  318. XPATTERN
  319. XYZZY-COMPAT (XYZZY)
  320. XYZZY-COMPAT-ASD
  321. YACC
  322. ZL
  323. ZPB-TTF
  324. ZPB-TTF-SYSTEM
  325. ZPNG

2009-11-09

KMRCLを眺める (9) aif2

| 01:04 | KMRCLを眺める (9) aif2 - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (9) aif2 - わだばLisperになる

今日は、KMRCLのmacros.lispの中からAIF2です。

何故かEXPORTされてないようなので、使う時にはEXPORTしましょう。

(そういえば、前回のALAMBDAのSELFもEXPORTされてませんでした…)

AIF2の2とは、多値(2値)を受け取れるIFという意味で、GETHASHなどと組み合せて使えます。

(LET ((HT (MAKE-HASH-TABLE)))
  (SYMBOL-MACROLET ((HT-FOO (GETHASH :FOO HT)))
    (SETF HT-FOO NIL)
    
    (AIF2 HT-FOO
          (SETF HT-FOO (LIST 42 IT))
          (SETF HT-FOO 0))
    HT-FOO))
;⇒ (42 NIL)
;   T

どの辺りが有用なのかを上のコードで説明すると、GETHASHで:FOOをキーにして値をNILに設定していますが、通常のIFだとNILの値が返ってきたのか、要素が見付からないのでNILが返ってきたのかが、1値目しか見えないため判定できません。

こういう場合に2値目も見てくれるAIF2が便利というわけです。

この説明だとアナフォリックな面はどうなんだということになってしまうのですが、ITが使えればもっと便利でしょう、多分。

定義はこんな感じです。

(defmacro aif2 (test &optional then else)
  (let ((win (gensym)))
    `(multiple-value-bind (it ,win) ,test
       (if (or it ,win) ,then ,else))))

ちなみにアナフォリックでないIF2もCLiki: fare-utilsなどで提供されています

2009-11-08

Shibuya.lisp TT#4無事終了!

| 03:20 | Shibuya.lisp TT#4無事終了! - わだばLisperになる を含むブックマーク はてなブックマーク - Shibuya.lisp TT#4無事終了! - わだばLisperになる

今回で4回目を迎えるShibuya.lisp。

大体4ヶ月に1度で、年3回のペースで開催していますが、

第1回目の開催から1年経ち、今回から2年目に入りました、早いものです。

今回は新しい取り組みが色々あったのですが、無事に上手くまとまって良かったです!

次回TT#5は、3月あたりを予定しています。

TT/LT発表者は常に募集していますので、よろしくお願いします!!

2009-11-07

KMRCLを眺める (8) alambda

| 02:11 | KMRCLを眺める (8) alambda - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (8) alambda - わだばLisperになる

今日は、KMRCLのmacros.lispの中からALAMBDAです。

ArcにもALAMBDAがあるのですが、LAMBDAがfnになっていることもありALAMBDAではなくて、afnとして存在しています。

これまで見てきたマクロはは、ITを暗黙に値が束縛された変数名としていましたが、ALAMBDAの場合は、自分自身にSELFという名前を付けます。

使われ方としては、

(FUNCALL (ALAMBDA (N)
           (IF (< N 2)
               N
               (+ (FUNCALL #'SELF (1- N))
                  (FUNCALL #'SELF (- N 2)))))
         10))
;⇒ 55

という感じでしょうか。

いきなり脱線で、

#+SBCL
(DEFUN |TAO-(_| (STREAM IGNORE)
  (CASE (PEEK-CHAR T STREAM)
    ((#\_)
     (READ-CHAR STREAM)
     (LET ((EXPR (SB-IMPL::READ-LIST STREAM IGNORE)))
       (IF (CONSP (CAR EXPR))           ;適当すぎ
           `(FUNCALL ,(CAR EXPR)
                     ,@(CDR EXPR))
           `(FUNCALL (FUNCTION ,(CAR EXPR))
                     ,@(CDR EXPR)))))
    (OTHERWISE
     (SB-IMPL::READ-LIST STREAM IGNORE))))

(DEFREADTABLE :TAO_
  (:MERGE :STANDARD)
  (:MACRO-CHAR  #\( #'|TAO-(_|)
  (:CASE :UPCASE))

のようなリーダーマクロを定義して、

(IN-READTABLE :TAO_)

(_(ALAMBDA (N)
    (IF (< N 2)
        N
        (+ (_SELF (1- N))
           (_SELF (- N 2)))))
  10)
;⇒ 55

と最近の?TAO風(CiNii 論文 -  Lispへのオブジェクト指向の自然な導入)に書けるようにするとFUNCALLがすっきりして見やすくなるかもしれません。

マクロの定義は、こんな感じです。

(defmacro alambda (parms &body body)
  `(labels ((self ,parms ,@body))
     #'self))

LABELSを使ってローカル関数を定義して、ボディ部で外にSELFを放り投げていますが、ナイスなアイデアですね。

自分はCLではあまりALAMBDAを使いたくなったことはないのですが、Arcのafnは標準の備え付けということと、LISP-1の見た目のすっきり感もあり、割と好きで使います。

もっと関数型っぽいスタイルが好きな人はYコンビネータを使うのかもしれません。

2009-11-06

KMRCLを眺める (7) acond

| 01:10 | KMRCLを眺める (7) acond - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (7) acond - わだばLisperになる

今日は、KMRCLのmacros.lispの中からACONDです。

大体予想は付くと思いますが、AIFのCOND版です。

使われ方としては、

(ACOND ((PROBE-FILE "/etc/foo") IT)
       ((PROBE-FILE "/etc/passwd") IT)
       (T NIL))
;⇒ #P"/etc/passwd"

という感じでしょうか。まったくぱっとした例ではありませんが…。

マクロの定義は、こんな感じです。

(defmacro acond (&rest clauses)
  (if (null clauses)
      nil
      (let ((cl1 (car clauses))
            (sym (gensym)))
        `(let ((,sym ,(car cl1)))
           (if ,sym
               (let ((it ,sym)) ,@(cdr cl1))
               (acond ,@(cdr clauses)))))))

IFでCONDの定義も一緒にやってる感じなので、ちょっと複雑になってます。

前回に引き続きSchemeでこれで似た感じのものは、condの=>があるでしょうか。

(define (probe-file file-name)
  (and (file-exists? file-name) file-name))

(cond ((probe-file "/etc/foo") => values)
      ((probe-file "/etc/passwd") => values)
      (else #f))

そもそもの例がぱっとしないのでこれもぱっとしませんが、Schemeでは、=>で関数に処理を投げることができますね。

ちなみに、上のコードの例だと、そもそも、ACONDである必要はなくて、

(COND ((PROBE-FILE "/etc/foo"))
      ((PROBE-FILE "/etc/passwd"))
      (T NIL))
;⇒ #P"/etc/passwd"

で書けてしまいます。

しかし、CLtLでは述語の返り値を使うようなスタイルは判りづらいので如何なものかと述べられています。確かにこの例でも何が返り値になるか読み取るのは難しいかもしれません。

さらに脱線ですが、この述語の返り値を割と積極的に使おうとしているマクロにAllegro CLのIF*があります。

もともとは、Franz LispのIFだったものを受け継いだもののようですが、上の例は、

(IMPORT 'ACL-COMPAT.EXCL:IF*)

(IF* (PROBE-FILE "/etc/foo")
     THENRET
ELSEIF (PROBE-FILE "/etc/passwd")
     THENRET
ELSE NIL)
;⇒ #P"/etc/passwd"

と書けます。

THENRETというのがポイントなのですが、これが述語の返り値を返すための指定です。これでCONDと記述力は同じになるわけですね。

…以上、ACONDからどんどん脱線してしまうのでこの辺りでこの辺で切り上げます…。

2009-11-04

KMRCLを眺める (6) aand

| 22:46 | KMRCLを眺める (6) aand - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (6) aand - わだばLisperになる

今日は、KMRCLのmacros.lispの中からAANDです。

使われ方としては、

(AAND (PROBE-FILE "/etc/passwd")
      (KMRCL:READ-FILE-TO-STRING IT)
      (SUBSEQ IT (PPCRE:SCAN "mysql" IT)))
#|
⇒ "mysql:x:115:126:MySQL Server,,,:/var/lib/mysql:/bin/false
Debian-exim:x:116:127::/var/spool/exim4:/bin/false
speech-dispatcher:x:117:29:Speech Dispatcher,,,:/var/run/speech-dispatcher:/bin/sh
couchdb:x:118:116:CouchDB Administrator,,,:/var/lib/couchdb:/bin/bash
kernoops:x:119:65534:Kernel Oops Tracking Daemon,,,:/:/bin/false"
|#

というのを無理矢理でっち上げました。

  1. ファイルが見付かったら
  2. そのファイルを一つの文字列にして
  3. mysqlが含まれる部分以降を出力する

です。これらの処理のでnilが返った時点でnilを返して次の節へは進まず打ち切りになります。

AANDは、itに束縛される内容が変化するというのが味噌ですね。

マクロの定義は、こんな感じです。

(defmacro aand (&rest args)
  (cond ((null args) t)
        ((null (cdr args)) (car args))
        (t `(aif ,(car args) (aand ,@(cdr args))))))

ちなみに、SchemeのSRFIには、AANDに似たようなものでありつつ、さらに汎用的なand-let*があります。

こちらには、Schemeの人が嫌いそうな、暗黙のitの束縛などはありません☺

2009-11-03

KMRCLを眺める (5) awhile

| 17:53 | KMRCLを眺める (5) awhile - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (5) awhile - わだばLisperになる

今日は、KMRCLのmacros.lispの中からAWHILEです。

使われ方としては、

(WITH-OPEN-FILE (IN "/etc/passwd")
  (AWHILE (READ-LINE IN NIL)
    (WRITE-LINE IT)))

という感じでしょうか。

(WITH-OPEN-FILE (IN "/etc/passwd")
  (DO ((IT (READ-LINE IN NIL) (READ-LINE IN NIL)))
      ((NOT IT))
    (WRITE-LINE IT)))

という風に展開されます。

自分的には、AWHILEはあまり好きでない系統なのですが、これは便利ですね☺

定義はこんな感じです。

(defmacro awhile (expr &body body)
  `(do ((it ,expr ,expr))
       ((not it))
     ,@body))

これを眺めていて、単純にLETのアナフォリック・マクロ版も割といけるんじゃないかと思いました。

(DEFMACRO ALET (PRED &BODY BODY)
  `(LET ((IT ,PRED))
     (DECLARE (IGNORABLE IT))
     ,@BODY))
(ALET (PROBE-FILE "/etc/passwd")
  IT)
;⇒ #P"/etc/passwd"

このALETで包めば制御構文はなんでもアナフォリック・マクロ的に書けるんじゃないかと思いましたが、中途半端ですね…。

ちなみに、Let Over LambdaのALETとは別ものです。

AWHILEには全然関係のない話ですが、Xyzzyや、Emacs Lispに慣れた人がCLで何か書こうとして遭遇するFAQに「whileがないんだけど…」というのがあります。

CLにはwhileはないんですよね。自作しましょう。

さらに脱線すると、Emacsの繰り返し構文がwhileベースになったのは、GNU Emacs開発当初のマシンは処理能力が貧弱で、その為にシンプルにしたという苦肉の策だったようです。

RMS自身はEmacs Lisp以外(Zetalisp等)では、普通にDOやLOOPを使っていて、whileマクロを定義したりしてはいない様子。

2009-11-02

KMRCLを眺める (4) awhen

| 01:37 | KMRCLを眺める (4) awhen - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (4) awhen - わだばLisperになる

これから連日ちょっとしか違いのないアナフォリック・マクロを読んで行くので退屈ですが、まあ、それも良しとします。

今日は、KMRCLのmacros.lispの中からAWHENです。

使われ方としては、

(AWHEN (PROBE-FILE "/etc/passwd")
  (FORMAT NIL "~A found" IT))
;=> "/etc/passwd found"


(AWHEN (PROBE-FILE "/etc/passwdxx")
  (FORMAT NIL "~A found" IT))
;=> NIL

みたいな感じでしょうか。述部の返り値がitに束縛されてボディで利用できます。

定義はこんな感じです。

(defmacro awhen (test-form &body body)
  `(aif ,test-form
        (progn ,@body)))

前回のAIFのelse部がないだけですが、実際に定義したAIFを利用して定義しています。

ユーザーが定義したマクロにどんどん積み重ねて行けるのがLISPマクロの良いところというのが、なんとなく分かってもらえるかもしれません。

ユーザー定義だからといってシステムの提供する構文とは別のものだと考える必要がないのが単純で良いところ。

そういうこともあって、LISP上に構築されたDSLはどこまで積み重ねても行っても結局LISPだ、とも言われます。

全く関係のない話ですが、Rubyを書いていると、いつもwhenを書いてしまいます。

else部が無い場合、ifじゃなくてwhenって書きたくなるんですよね…。