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 |

2011-02-28

(funcall #'foo) vs (funcall 'foo)

| 19:51 |  (funcall #'foo) vs (funcall 'foo) - わだばLisperになる を含むブックマーク はてなブックマーク -  (funcall #'foo) vs (funcall 'foo) - わだばLisperになる

Twitterでもぶつぶつ言っていたのですが、(FUNCALL 'FOO)と、(FUNCALL #'FOO)では色々と意味が違ってきます。

基本的に、(FUNCTION FOO)を使った場合は、関数オブジェクトを扱っているような感じかなと思いますし、(QUOTE FOO)の場合は、SYMBOL-FUNCTIONを実行時に呼ぶという感じかなと思います。

他にもなんやかんやとありますが、インライン展開でも違いがあることがあるというのをみつけたので記念にメモ。

元はといえば、SBCLのFUNCTIONのところのコメントに書いてあったことなのですが、インライン展開にも違ってくるようです。

どういうことかというと、

(declaim (inline bar))
(defun bar ()
  "こんにちは")

と定義しておいて、それを呼び出す側で、 (quote)と (fuction)のものを比較してみます。

quoteを使う

(defun foo ()
  (funcall 'bar))
(foo)
; disassembly for FOO
; 079DBA04:       BA18000000       MOV EDX, 24                ; no-arg-parsing entry point
;       09:       488B05A0FFFFFF   MOV RAX, [RIP-96]          ; #<FDEFINITION object for BAR>
;       10:       B908000000       MOV ECX, 8
;       15:       FF7508           PUSH QWORD PTR [RBP+8]
;       18:       FF6009           JMP QWORD PTR [RAX+9]
;       1B:       CC0A             BREAK 10                   ; error trap
;       1D:       02               BYTE #X02
;       1E:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;       1F:       54               BYTE #X54                  ; RCX

当然かもしれませんが、インライン展開されません。

functionを使う

(defun foo2 ()
  (funcall #'bar))
(foo2)
; disassembly for FOO2
; 083A0BC4:       488B15A5FFFFFF   MOV RDX, [RIP-91]          ; "こんにちは"
                                                              ; no-arg-parsing entry point
;       CB:       488BE5           MOV RSP, RBP
;       CE:       F8               CLC
;       CF:       5D               POP RBP
;       D0:       C3               RET
;       D1:       CC0A             BREAK 10                   ; error trap
;       D3:       02               BYTE #X02
;       D4:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;       D5:       54               BYTE #X54                  ; RCX

展開してみると埋め込まれていることが分かります。

大抵の場合においてFUNCTIONを使っておけば良いかなというところで、あえてFUNCTIONを使わないのだという場合には、むしろ(FUNCALL (SYMBOL-FUNCTION 'FOO))と書いた方がわかりやすいかもしれません。まあ、(FUNCALL 'FOO)の方が(FUNCALL #'FOO)より見た目が短かくて簡潔なのですが…。

lambdaの形とletの形

| 18:35 | lambdaの形とletの形 - わだばLisperになる を含むブックマーク はてなブックマーク - lambdaの形とletの形 - わだばLisperになる

letはlambdaを変形すれば作ることができるというのはよく知られているかと思います。

ふとmap系の関数もlambda系な配置なので、これをlet系に変形したらどうかなと思い、

(defmacro mlet ((&rest binding) &body body)
  `(mapcar (lambda (,@(mapcar #'car binding))
             ,@body)
           ,@(mapcar #'cadr binding)))

のようなものを書いてみました。

(mlet ((x '(1 2 3 4 5))
       (y '(a b c d e)))
  (list x y))
;=> ((1 A) (2 B) (3 C) (4 D) (5 E))

dolistの複数回せるdolistsというマクロを良くみますが、それがリストの返り値を返すものというところでしょうか。

これは絶対他の人も考えてるだろうなと思ったのでmletとかlmapとかmaplet等色々な組み合わせで検索してみたところ、そのものずばりなErann Gatさん作のmapletをみつけました。

(defmacro maplet (bindings &body body)
  `(mapcar (fn ,(mapcar #'car bindings) ,@body)
           ,@(mapcar #'second bindings)))
(maplet ((x '(1 2 3 4 5))
         (y '(a b c d e)))
  (list x y))
;=> ((1 A) (2 B) (3 C) (4 D) (5 E))

mapletという名前の方が良いですね。

mapcarとmapletの違いですが、mapletは構文にする必要があるのでマクロになるため、APPLYに渡す、ということができなくなったりします。また、無名関数以外を渡すときに逆に引数を書いてやらないといけない手間が増えたりしますが、無名関数を書くのが面倒ということの方が多い気がするのでmapletも結構便利かもしれないと思いました。

ちなみに、似たようなところでは、TAOのimageがあり

(image i '(1 2 3 4) (* 2 i))
;=> (2 4 6 8)

という風に括弧が少ない版のmapletという感じです。dolistの括弧が少ない版とも考えられるかもしれません(ボディ部は1つの式しか取れないようです。)

また、これを拡張した、imagenというのがあり、mapletの括弧が少ない版という感じです。

(imagen (i '(1 2 3 4))
        (j '(a b c d))
        (list i j))
;=> ((1 A) (2 B) (3 C) (4 D))

lambda <=> let で色々変形を試してみると思わぬ発見があるやもしれません。

オブジェクト指向コンピューティング

| 18:20 | オブジェクト指向コンピューティング - わだばLisperになる を含むブックマーク はてなブックマーク - オブジェクト指向コンピューティング - わだばLisperになる

昨年に復刊して驚いた「Common Lisp オブジェクトシステム」もCLOSを知る上では良いかなと思うのですが「CLOSCLOS MOPを知るには良い本」的な紹介を良く耳にする気がしています。

この本についての個人的な感想は以前にも書いたのですが、

どちらかというと言語の実装者向けかなあと思っています。

それでタイトルの本なのですが、オブジェクト指向のシステムの解説の一つとして40ページ程のボリュームでCLOS MOPが取り上げられていて、実際にコードの例も示されているという、日本語の本にしては珍しい本です。

また、オブジェクト指向を解説する本としても、かなりマニアックで、Smalltalkあり、リフレクションあり、並列分散オブジェクト指向言語のABCLなども取り上げられつつ、という感じです。

先日の米澤教授の最終講義で並列分散オブジェクト指向のABCLって面白そう!と思った方にもお勧めかなと思います。

それで現在この本は絶版のようなのですが、以前からAmazonでウォッチしているところでは、何十円だったり一万円を越えたりという感じです。(現在衝撃の48円)

2011-02-27

適当な書き捨て仕事 2011/02/27

| 00:04 | 適当な書き捨て仕事 2011/02/27 - わだばLisperになる を含むブックマーク はてなブックマーク - 適当な書き捨て仕事 2011/02/27 - わだばLisperになる

やりたいこと

今の職場ではどういうわけか日報的なものがWordPressのブログになっておりここに書くとWordPressのプラグインの機能で社内にメールが飛んでいます。

日報に書いてある研究開発時間の今年度分を纏められないかと言われたのですが、集計すると思ってなかったので、このブログにしかデータがなく、このブログからデータを引っ張ってこなければなりません。

ということで、適当な書き捨て仕事のお題がみつかったのでCommon Lispでやってみます。

使うもの

  • CLSQL
    • とりあえす、WordPressは、MySQLにデータが格納されているので、CLSQLでデータを抜き出すことにします。
      • (ql:quickload :clsql)
  • Series
    • 今年はLOOPマクロ使用禁止で頑張ってみているので、SeriesかIterateを使うことになります。ということでSeriesです。
      • (ql:quickload :series)
  • cl-ppcre
    • もはや常に必須です
  • aprogn

下準備

CLSQLは、リーダーマクロを使うとS式な感じで書けるので、リーダーマクロを使ってみます。とはいえ自分的にCLSQLのリーダーマクロを使うのは初めてだったりします。

Seriesもリーダーマクロを使うと色々良い感じになります

(progn
  (series::set-dispatch-macro-character
   #\# #\Z (cl:function series::series-reader))
  (series::set-dispatch-macro-character
   #\# #\M (cl:function series::abbreviated-map-fn-reader))
  (clsql-sys:enable-sql-reader-syntax))

DBに接続

(progn
  (clsql-sys:connect '("localhost" "log" "***" "***")
                     :database-type :mysql)
  (clsql-sys:execute-command "set character_set_client='utf8'")
  (clsql-sys:execute-command "set character_set_connection='utf8'")
  (clsql-sys:execute-command "set character_set_results='utf8'")  )

文字コードを合せたりなんやり。

(defun foo-all ()
  (aprogn
    (clsql:select [post_date] [post_content] :from [log_wp_posts]
                  :where [= 2 [post_author]])
    ;;
    (mapping (((date text) (#2Mvalues-list (scan it))))
      (let ((date (ppcre:regex-replace " ..:..:.." date ""))
            (rh (ppcre:register-groups-bind ((#'parse-integer hs))
                                            (".*研究開発時間\\D*(\\d+).*" text)
                  hs)))
        (list date rh)))
    ;;
    (collect it)))

適当にREPLで、CLSQLを使って目当てのテーブルを探して該当のものをずらっと抜き出します。

マニュアルのとおりに[post_date]のような記述をしてもさっぱり拾ってこないのですが、中の文字列がシンボルの扱いになっていて、大文字になっているのが原因のようです。

ということで、["post_data"]とか[|post_data|]と書けば回避できるのですが、横道に逸れてCLSQL側を変更します。

眺めてみたところSQL-READER-OPENの中で、READ-DELIMITED-LISTが読み込んでいるようなのでこの関数が読み込みに使うリードテーブルはシンボルを大文字に揃えないように変更。

(defun sql-reader-open (stream char)
  (declare (ignore char))
  (let ((*readtable* (copy-readtable)))
    (setf (readtable-case *readtable*) :preserve)
    (let ((sqllist (read-delimited-list #\] stream t)))
      (unless *read-suppress*
        (handler-case
            (cond ((string= (write-to-string (car sqllist)) "||")
                   (cons (sql-operator 'concat-op) (cdr sqllist)))
                  ((and (= (length sqllist) 1) (eql (car sqllist) '*))
                   (apply #'generate-sql-reference sqllist))
                  ((sql-operator (car sqllist))
                   (cons (sql-operator (car sqllist)) (cdr sqllist)))
                  (t (apply #'generate-sql-reference sqllist)))
          (sql-user-error (c)
            (error 'sql-user-error
                   :message (format nil "Error ~A occured while attempting to parse '~A' at file position ~A"
                                    (sql-user-error-message c) sqllist (file-position stream)))))))))

あまりマニュアルも読んでないし、こういう対策はやっぱりまずいのかなと色々と調べようと思いはじめましたが、仕事が終わらないので引き返し。

とりあえず、ブログの中身に目的の文字列があるのでCL-PPCREで適当に抜き出します。

どんな関数名にして良いのか分からないので名前は適当です。

ここで動作確認

(subseq (foo-all) 100 110)
;=> (("2010-04-16" 3) ("2010-04-19" 2) ("2010-04-19" 3) ("2010-04-19" 3)
;    ("2010-04-20" 3) ("2010-04-20" 2) ("2010-04-20" 3) ("2010-04-21" 4)
;    ("2010-04-21" 3) ("2010-04-21" 2))

まあ良いんではないかと。

次に月ごとに集計する必要があるようなので、上記のデータを月毎に纏めるものを書くことにしました

(defun mtotal (yyyy m)
  (let ((mon1 (format nil "~D-~2,'0D" yyyy m))
        (mon2 (format nil "~D-~2,'0D" yyyy (1+ m))))
    (aprogn
      (scan (foo-all))
      ;;
      (choose-if (f_ (and (string< mon1 (car _))
                          (string> mon2 (car _))))
                 it)
      ;;
      (#Msecond it)
      ;;
      (choose it)
      ;;
      (collect-sum it))))

string<で比較するというかなり強引な方法です。

動作確認

(mtotal 2010 04)
;=> 71

できた後で、これ明かにSQLでやるべきだろうと思いましたが、まあ、もう良いやと。

意味なく表示用の関数を作成

(defun pp-mtotal (yyyy mm)
  (format 'T
          "~&~A-~A月~%研究開発時間: ~A時間~2%"
          yyyy
          mm
          (mtotal yyyy mm)))
(pp-mtotal 2010 4)
;-> 2010-4月
;   研究開発時間: 71時間
;
;=> NIL

いや、CSVでデータを提出した方が良いんじゃないかと。まあ、とりあえず良し。

次に年度を全て表示するものを作成

(defun foo-total (start)
  (format t "~&~V@{~A~:*~}~*~%" 40 "=")
  (aprogn
    (scan-range :from 0 :upto 11)
    ;;
    (#M(lambda (x)
         (let ((m (+ 3 x)))
           (list (if (< 11 m)
                     (1+ start)
                     start)
                 (1+ (mod (+ 3 x) 12)))))
      it)
    ;;
    (#M(lambda (x) (apply #'pp-mtotal x)) it)))

ここで、

(#M(curry #'apply #'pp-mtotal) it)

のように書きたいのに、リーダーマクロの展開で、#'(curry ...)となってしまうために、こういう記述ができないことを発見。

まったく仕事と関係ないですが、Seriesの定義を確認しに行きます。

#Mの次にくるものがコンスだった場合(おそらくlambda式を期待)はfunctionで囲む、となっていました。

Seriesは、CLtL1の時代のものなのでこれはこれで正しいですが、ANSIでは、lambdaマクロにより#'を補えるのと、今回のようなこともあるのでここはfunctionは補わなくても良いだろうということで、改造。

(cl:defun mapit (type fn args)
  (if (not (symbolp fn))
      `(map-fn ',type ,fn ,@ args)      ;シンボルでない場合はfunctionを付けない
    (cl:let ((vars (do ((a args (cdr a))
                        (l nil (cons (gensym "V-") l)))
                       ((null a) (return l)))))
      `(map-fn ',type (function (lambda ,vars (,fn ,@ vars))) ,@ args))))

でも、(#M(setf foo)...)とかには、#'が付かないとまずいよなあ、などと思ったりしましたが、setf関数など使いそうにもないし、横道に逸れすぎるので切り上げます。

(defun foo-total (start)
  (format t "~&~V@{~A~:*~}~*~%" 40 "=")
  (aprogn
    (scan-range :from 0 :upto 11)
    ;;
    (#M(lambda (x)
         (let ((m (+ 3 x)))
           (list (if (< 11 m)
                     (1+ start)
                     start)
                 (1+ (mod (+ 3 x) 12)))))
      it)
    (#M(curry #'apply #'pp-mtotal) it)))

のように書けるようになり、めでたしめでたし。

また、年を跨ぐ処理が面倒だったので適当にやっつけています。SQLで処理してればこんなことないのに。

というように、自分がCommon Lispで書く場合、いかに横道に逸れないかが重要である気がしつつあります。

2011-02-26

同じ:testを指定するのが面倒

| 14:00 | 同じ:testを指定するのが面倒 - わだばLisperになる を含むブックマーク はてなブックマーク - 同じ:testを指定するのが面倒 - わだばLisperになる

(member "bar"
        (delete "foo"
                (delete-duplicates
                  (copy-list '(delete "foo" "bar" "baz" "foo" "FOO")))))

のような物を書いた場合、比較するものが文字列になるため、デフォルトのeqlでは比較できていないことになります。

きちんと比較できるようにするには、:testにstring=などを指定して比較にstring=を使うことにしてやれば良いのですが、

(member "bar"
        (delete "foo"
                (delete-duplicates
                  (copy-list '(delete "foo" "bar" "baz" "foo" "FOO"))
                  :test #'string=)
                :test #'string=)
        :test #'string=))

という風になります。長くて重複しているわけです。

これが面倒だなあと以前から思っていたので、どうにかできないかと思ってマクロを書いてみました。

(defvar *foo-operators*
  (atap ()
    ;; clパッケージから:testを受け付けるオペレーターを探す
    (do-symbols (sym :cl)
      (when (and (fboundp sym)
                 (member 'test (member '&key (kl:flatten (swank::arglist sym)))
                         :key #'princ-to-string :test #'string-equal))
        (push sym it)))))

(defun add-test (expr test-fn)
  (labels ((*self (expr)
             (destructuring-bind (&optional car &rest cdr) expr
               (cond ((null expr) () )
                     ;;
                     ((consp car)
                      (cons (*self car) (*self cdr)))
                     ;;
                     ((eq 'quote car) expr)
                     ;;
                     ((member car *foo-operators*)
                      `(,car ,@(*self cdr) :test ,test-fn))
                     ;;
                     ('T (cons car (*self cdr)))))))
    (*self expr)))

(defmacro with-default-test (test &body body)
  `(progn
     ,@(add-test body test)))

上のatapは、

(let ((it () ))
  ...
  it)

と等価です。RubyのtapやGaucheのrlet1のアナフォリック版というところです。

使い方は、

(with-default-test (f (x y) (string-equal x y))
  (member "bar"
          (delete "foo"
                  (delete-duplicates
                   (copy-list '(delete "foo" "bar" "baz" "foo" "FOO"))))))

という感じに書くと

(progn
 (member "bar"
         (delete "foo"
                 (delete-duplicates
                  (copy-list '(delete "foo" "bar" "baz" "foo" "FOO"))
                  :test (f (x y) (string-equal x y)))
                 :test (f (x y) (string-equal x y)))
         :test (f (x y) (string-equal x y))))

という風になります。

ちなみに、既に:testが指定されていたらどうするかは考えていないのですが、指定のものを優先とするのが妥当かなと思っています。

2011-02-22

適当な書き捨て仕事 2011/02/22

| 20:52 | 適当な書き捨て仕事 2011/02/22 - わだばLisperになる を含むブックマーク はてなブックマーク - 適当な書き捨て仕事 2011/02/22 - わだばLisperになる

ちゃちゃっとした仕事は、シェルだのPerlだのRubyだので済ませる人が多いかと思いますが、Common Lispでも道具を揃えておけばそれなりに色々できますし…

という日々の内容を思い付いたらだらだら書いたり書かなかったりして行きたいと思います。

以前にも

みたいなものを書いてみたりしてました。これからも似たような内容が多くなりそうです…。

最初に断わっておくと基本的に自分の場合は、#!スクリプトにするのではなく、SLIME上で式を実行するというスタイルがメインです。

REPLで結果を確認しつつ作成し、完成したら出力のストリームをファイルに向ける、という一行野郎を書くようなスタイルで書けたりするので割と効率が良いのではないでしょうか。

やりたいこと: CSVファイルのデータをHTMLとして仕立てなおす

(with-> "/tmp/foo.html"
  (letS* (((date pref sche)
           (Elist (fare-csv:read-csv-file "/var/tmp/foo.csv"))))
    (Rignore
     (format >
             "
  <div class=\"foo\">
    <div class=\"bar\">
      <h3>日 時</h3>
      <p>~A</p>
    </div>
    <div class=\"baz\">
      <h3>場 所</h3>
      <p>
~A
      </p>
    </div>
    <div class=\"quux\">
      <h3>内 容</h3>
      <p>
~A
      </p>
    </div>
  </div>
"
             (aprogn date
                     (ppcre:regex-replace "日" it "")
                     (ppcre:regex-replace "月" it "/")
                     (ppcre:regex-replace "^" it "2011/"))
             (ppcre:regex-replace-all
              "\\n"
              pref
              "<br />")
             (ppcre:regex-replace-all
              "\\n"
              sche
              "<br />")))))

カサカサカサっと2、3分もかからず書けると思います。HTMLは既存のものをコピペして穴を空けています。

道具

  • 正規表現
    • cl-ppcreです。Quicklispでインストールできます。(ql:quickload :cl-ppcre)
  • CSVファイルの読み込み
    • fare-csvを使います。Lisperに優しく結果がリストで返ってきます(ql:quickload :fare-csv)
  • with->
    • with-open-fileの出力専用バージョンで上書き(:if-exists :supersede)、かつストリームがボディ内で、>という変数名で参照できるという自作適当マクロです。
  • letS*、Rignore
    • 自分が良く使っているSeriesを扱うloopマクロみたいなものです。分配束縛ができます。古のマクロを自作で復活させて使ってるだけで完全なる趣味です。
  • aprogn
    • 入れ子を解消する自作のマクロです。
(aprogn date
        (ppcre:regex-replace "日" it "")
        (ppcre:regex-replace "月" it "/")
        (ppcre:regex-replace "^" it "2011/"))

(ppcre:regex-replace "^" (ppcre:regex-replace "月" (ppcre:regex-replace "日" date "") "/") "2011/")

みたいに展開されます。直前の式がitの部分に展開されます。

書いてる途中で、同じ関数が連続する場合は、

(aprogn date
        (ppcre:regex-replace "日" it "")
        (// "月" it "/")
        (// "^" it "2011/"))

みたいに書けたらナイスなんじゃないだろうか!などと思いましたが、横道に逸れると仕事が終わらないので自重しました。そもそもそんなに同じ関数が連続になることもないのであまり効果がなさそうです。

2011-02-19

CREATE-SERVERしたSWANKに接続すると日本語の評価で切断してしまう

| 21:12 | CREATE-SERVERしたSWANKに接続すると日本語の評価で切断してしまう - わだばLisperになる を含むブックマーク はてなブックマーク - CREATE-SERVERしたSWANKに接続すると日本語の評価で切断してしまう - わだばLisperになる

自分は、SLIMEはEmacsから起動しないで別途SWANKサーバーを立ててそこに接続する派なのですが、最近になって日本語を評価すると接続が切断されるという現象に遭遇するようになりました。

*slime-events*を見ると、

(:coding-system "iso-latin-1-unix" :external-format "LATIN-1")

となっていて、UTF-8になっていないのが原因ということは分かりますが、Emacs側のslime-net-coding-systemもutf-8-unixだし、CL処理系のEXTERNAL-FORMATもUTF-8にしているし、どういうことなのかと。

調べてみたところ、SWANK:CREATE-SERVERではcoding-systemが別途指定できるようになっていて、指定がないためデフォルトの指定になっている、ということが分かりました。

ということで、

(swank::create-server :port 4005
                      :coding-system "utf-8-unix"
                      :dont-close 'T)

のようにしたところ問題は解決。

:coding-systemを与えないと、デフォルトでは、SWANK::*CODING-SYSTEM*を参照するようですが、これがiso-latin-1-unixになっているようです。

ということで、こちらをutf-8-unixに変更してもOKです。

2011-02-16

C.I.CLを眺める(8) HASHED-DELETE-DUPLICATES

| 18:23 | C.I.CLを眺める(8) HASHED-DELETE-DUPLICATES - わだばLisperになる を含むブックマーク はてなブックマーク - C.I.CLを眺める(8) HASHED-DELETE-DUPLICATES - わだばLisperになる

今回は、C.I.CLのlist.lispから HASHED-DELETE-DUPLICATES です。

定義は、

(DEFUN HASHED-DELETE-DUPLICATES (SEQUENCE &KEY (TEST (FUNCTION EQL))
                                 TEST-NOT
                                 (START 0) (END (LENGTH SEQUENCE))
                                 (KEY (FUNCTION IDENTITY))
                                 (FROM-END NIL))
  (HASHED-REMOVE-DUPLICATES
   SEQUENCE :TEST TEST :TEST-NOT TEST-NOT :START START :END END
   :KEY KEY :FROM-END FROM-END))

ですが、一連のHASHED-*-DUPLICATESは、ハッシュに登録して重複を取り除くということから、原理的に元の配列を破壊することはない、ということなのか、REMOVEのバージョンをそのまま呼び出しています。

前回のものは、セットを作るものでリストとは違い順番等は無視できましたが、今回は、リストを対象にするもののようです。

動作はREMOVE系と同じなので書く意味もあまりないですが、

(import 'com.informatimago.common-lisp.list::hashed-delete-duplicates)
;=> T

(hashed-delete-duplicates "fooo")
;=> "fo"

(hashed-delete-duplicates #(f o o o o))
;=> #(F O)

(hashed-delete-duplicates '(f o o o o))
;=> (O F)

というところ

2011-02-12

Conditional Expression パターンで複数の値を返したい

| 15:22 | Conditional Expression パターンで複数の値を返したい - わだばLisperになる を含むブックマーク はてなブックマーク - Conditional Expression パターンで複数の値を返したい - わだばLisperになる

Conditional Expressionパターンとは、

(format t
        "~A~%"
        (if (zerop (random 2)) "foo" "bar"))
;-> bar
;
;=> NIL

;のようなもので、値を返すのが基本の言語を使っている人なら割と慣れ親しんだ記法かと思います。

ifが式でなくて、値を返さない言語だと

(if (zerop (random 2))
    (format t "~A~%" "foo")
    (format t "~A~%" "bar"))
;-> foo
;
;=> NIL

のように書くことになりますが、この辺りの扱いの違いに目をつけてパターンとして名前を付けたのかもしれません。

結構好きなパターンですが、Smalltalkベストプラクティスを読んだときに名前が付いているのをみつけました。

それはさておき、このConditional Expressionパターンは、1つの値を返すときは、上の例のように書けば良いのですが、複数の値を返したい場合や、部分的に共通のところがあったりした場合に、どうしたもんかと考えています。

リストを返してapplyというのも良いと思いますが、無駄なリストが作られるので、ここは多値だろう、ということで

(multiple-value-call #'format t "~A: ~A ~A~%"
  (if (zerop (random 2))
      (values "foo" 2 "foo")
      (values "bar" 2 "baz")))
;-> foo: 2 foo
;
;=> NIL

と書いてみます。

しかし、

(if (zerop (random 2))
    (format t "~A: ~A ~A~%" "foo" 2 "foo")
    (format t "~A: ~A ~A~%" "bar" 2 "baz"))
;-> foo: 2 foo
;
;=> NIL

と比べるとなんだか難解。過ぎたるは及ばざるが如しか…。

ちなみに、SBCLの場合ですが、多値で返して、MULTIPLE-VALUE-CALLするのも、リストを返してAPPLYするのも効率的には同じようです。

(dotimes (i 100000)
  (multiple-value-call #'values 8 (if t (values 8 8) (values 9 9))))
;⇒ NIL
----------
Evaluation took:
  0.008 seconds of real time
  0.010000 seconds of total run time (0.010000 user, 0.000000 system)
  125.00% CPU
  20,665,188 processor cycles
  0 bytes consed

Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz
(dotimes (i 100000)
  (apply #'values 8 (if t (list 8 8) (list 9 9))))
;⇒ NIL
----------
Evaluation took:
  0.009 seconds of real time
  0.010000 seconds of total run time (0.010000 user, 0.000000 system)
  111.11% CPU
  21,332,376 processor cycles
  0 bytes consed ; コンスされていない…

Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz

理由はAPPLYがMULTIPLE-VALUE-CALLの式に変形されるという最適化が施されているからのようです。

;;;; transforming APPLY

;;; We convert APPLY into MULTIPLE-VALUE-CALL so that the compiler
;;; only needs to understand one kind of variable-argument call. It is
;;; more efficient to convert APPLY to MV-CALL than MV-CALL to APPLY.
(define-source-transform apply (fun arg &rest more-args)
  (let ((args (cons arg more-args)))
    `(multiple-value-call ,fun
       ,@(mapcar (lambda (x)
                   `(values ,x))
                 (butlast args))
       (values-list ,(car (last args))))))

若干悔しいので MULTIPLE-VALUE-CALLの方が便利な局面を探してみました。

一つ見付けたのは、 MULTIPLE-VALUE-CALL だと、最後の要素が複数でも単数でも良いので、

(multiple-value-call #'values 8 
                              (if t (values 8 8) (values 9 9)) 
                              (values 'x 'y) 
                              'z)
;=> 8
;   8
;   8
;   X
;   Y
;   Z

みたいなことができます。

なんやかんやと書きましたが、とりあえず処理系全般的にリストを返すよりは効率が良い筈ではあります。

2011-02-11

nth-valueの名前が長くて不便なので

| 14:34 | nth-valueの名前が長くて不便なので - わだばLisperになる を含むブックマーク はてなブックマーク - nth-valueの名前が長くて不便なので - わだばLisperになる

nth-valueの名前が長くて不便でインデントの具合も色々バランスが悪いので (nth-value 1 ,@form) を (\1 ,@form) と書けるようにしてみる

(dotimes (i 10)
  (eval `(defmacro ,(intern (format nil "~D" i)) (form)
           `(nth-value ,,i ,form))))

(\3 (decode-universal-time (get-universal-time)))
;=> 11

思ったより良い感じ

2011-02-06

モンスターコアの作り方

| 17:59 | モンスターコアの作り方 - わだばLisperになる を含むブックマーク はてなブックマーク - モンスターコアの作り方 - わだばLisperになる

自分はできるだけ沢山ライブラリを読み込んだコアを作り、その中で作業するのが好きなのですが、Quicklispを使いつつモンスターコアを作る方法を模索しています。

そんな感じの模索をメモ

下準備

  • asdf2を利用します。
  • Quicklispが管理するものは、Quicklispに任せて、Quicklispに登録されていないものは、

/l/src/

などの下に置くことにしてみます。ここで、/l/srcは、asdf.confで

(:tree "/l/src/" )

として、ディレクトリ以下に置かれたものは全部読まれるようにしておきます。

  • 処理系は、SBCLを利用します

ライブラリの読み込み

モンスターコアを作成する際は、なんといってもライブラリを沢山読み込むのでロードのエラーの対策が面倒なのですが、ばっさり無視すると大分楽になります。

asdf2では、MAP-SYSTEMSで登録されたライブラリ(モジュール?システム?)を総なめにできるようなので、それを使って全部読み込みます。

(asdf:map-systems
 (lambda (x)
   (when (nth-value 1
                    (ignore-errors
                      (asdf:load-system (asdf:component-name x))))
     (format t "~80@{=~}~%" t)
     (format t "Load failed: ~A~%" (asdf:component-name x))
     (format t "~80@{=~}~%" t))))

これで大体は読み込めました。

※ちなみに、実際のところ、この方法で、全部のasdファイルを読んでくれてはいないようなのですが、正しい方法をご存じの方は教えてください。

ライブラリが読み込まれたので、イメージをダンプします。

(progn
  (setq sb-impl::*default-external-format* :utf-8)
  (pushnew (lambda ()
             (in-package :g000001)
             (swank::create-server :port 4005 :dont-close 'T))
           sb-ext:*init-hooks*)
  (sb-ext:save-lisp-and-die (format nil "/l/swank-sbcl-~A" (lisp-implementation-version))
                            :purify 'T :executable 'T))

SBCLの場合は、sb-ext:*INIT-HOOKS*に起動時に呼び出す関数を登録できるので、ここでSWANKを起動させます。

また、

(in-package :g000001)

というのは、自分用のcl-userパッケージのようなものです。

上記のようにすると、/l/swank-sbcl-1.0.45

のような実行可能ファイルができるので、実行すると、SWANKサーバーが起動します。

あとは、SLIMEからSWANKサーバーに、slime-connect等で接続すればOKです。

※M-x slimeで起動させる場合には、swank:CREATE-SERVERはしないバージョンを作成しておいて、SLIMEslime-lisp-implementationsに登録すればOKではないでしょうか(多分)

自分の場合は、さらに読み込んでくれなかったライブラリを手動で追加したりしています。

そんなこんなで、現在パッケージ数:954、大きさ、419MBのイメージができました。めでたしめでたし。