#:g1: frontpage

 

lw-add-ons の紹介

Posted 2021-07-11 20:22:43 GMT

一時期Lisp関係のライブラリを紹介するというのをやっていましたが、最近はそういうのもすっかりご無沙汰です。

そんな近頃ですが、最近、UltralispにLispWorksのdistができたので、このなかに収録されているlw-add-onsを久々に紹介してみます。

ちなみに、LispWorksのdistができた背景ですが、Quicklispのquicklisp distはSBCLで動作確認をしている関係からSBCLで動かないものは一切収録されておらず、lw-add-onsのようなLispWorks固有のライブラリは、配布の枠組みは作っているので誰かが独自のdistをまとめれば良いだろう、という雰囲気でした。
そういう流れのところに、たまたまUltralispの作者が最近LispWorksを利用するようになったので、処理系固有のdistとして試しにLispWorksのdistができた、という感じだと思います。

lw-add-ons とはなにか

lw-add-ons はcl-ppcre等でお馴染のEdmund Weitz氏が作製した、LispWorksのIDEをEmacs+SLIMEの環境に近付けるような拡張です。

試してみる

拡張の説明はライブラリのドキュメントに書いてあるので使い勝手的なところや、個人的なカスタマイズについて書いていきたいと思いますが、改めてドキュメントを確認してみると、開発当初の2005年のLispWorks 4.4の時代にはLispWorks IDEに存在しなかった機能も、LispWorksの版を重ねるごとに本体に取り込まれており、取り込まれていない機能は、arglistの表示の"Insert Space and Show Arglist"や、ドキュメントを開く、"Meta Documentation"とSLIMEのREPLのショートカット機能的なリスナーの拡張機能位になってしまいました。

個人的にはキーバインドをSLIMEにさらに近付けて使ったりしています。

;;; SLIMEのslime-doc-mapの模倣
(defvar *slime-doc-map* (editor::make-key-table))

(editor::set-table-entry (editor::get-table-entry (editor::get-right-table :global :emacs) (editor::crunch-key "Control-c")) (editor::crunch-key "Control-d") *slime-doc-map*)

;;; c-c c-d h でドキュメントを開く(SLIMEではHyperSpecを開く) (editor::set-table-entry *slime-doc-map* (editor::crunch-key "h") (editor::find-command "Meta Documentation"))

また、LispWorksはMOPのドキュメントも標準で添付されてくるので、これを活用するように設定してみています。

(progn
  (setq lw-add-ons:*mop-page*
        (lw:lispworks-file  "manual/online/MOP/mop/dictionary.html"))
  (lw-add-ons::collect-mop-links))

まとめ

Lispの開発環境単体で比較するなら、多分SLIMEよりLispWorksの方が強力なのですが、Emacs+SLIMEの方は、マルチプラットフォームでかつLisp開発で活用できる強力なテキスト編集拡張が存在するというのが、かなりの強みだなと思います。

まあ、LispWorksへEmacsのライブラリを移植すれば良いのですが、便利な拡張ライブラリはコードのボリュームも多くなかなか面倒です。


HTML generated by 3bmd in LispWorks 7.0.0

srfi 88の紹介

Posted 2014-12-31 15:00:00 GMT

 LISP Library 1000 の366回目です。
毎日は書きませんが、中途半端なストックがあるので、たまにちょろちょろ出していきます。

srfi 88とはなにか

 srfi 88は、Marc Feeley氏によるSchemeのキーワードオブジェクトについての提案です。

パッケージ情報

パッケージ名srfi 88
SRFI 88SRFI 88: Keyword objects

試してみる

 Lispとキーワード引数というとCommon Lisp、さらに遡るとZetalispあたりが起源になるかと思いますが、これらの形式は、:fooという風にコロンが前置されます。
Smalltalkだとコロンは後置されますが、オブジェクト指向言語は、こちらに倣っていることが多いようで、Dylanもこっちです(といってもシンボルの表記ですが)。
今回紹介するsrfi 88では、後置形式を採用しています。何故後置かですが、別にSmalltalkに倣った訳ではないらしく、srfi-42の様に前置のコロン付きのシンボルを利用している既存のプロジェクトと競合しないように選んだようです。
軽く確認してみたところでは、デフォルトでキーワードを後置のコロンで表わす処理系は、Chicken、STKlos等がありますが、それぞれ、#:fooや、:fooで書けたりもするようです。

 このsrfiで定義されている関数は、keyword?、keyword->string、string->keywordの3つのみです。
ちなみに、Chickenだと、(keyword? ':) => #fだったりして微妙ですが、空白文字からstring->keywordしたものを戻すと処理はされるので印字表現と読み込みの関係の問題かもしれません。

(keyword? 'foo:)
;=> #t

(keyword->string (string->keyword "")) ;=> ""

まとめ

 Lispのキーワードが前置にコロンになったのはパッケージ表記の問題だと思いますが、キーワード引数をメッセージの表記として多用する、Smalltalkに影響を受けたFlavorsは、キーワード引数というものが確立する前に誕生していました。
この辺りの経緯もいつか詳しくまとめてみたいところです。

YTools: Backquoteの紹介

Posted 2014-12-30 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の365日目です。

YTools: Backquoteとはなにか

 YTools: Backquoteは、Drew McDermott氏のユーティリティであるYtoolsの中で定義されている独自のバッククォート式です。

パッケージ情報

パッケージ名YTools: Backquote
Quicklisp×
プロジェクトページHome page for Drew McDermott
CLiKiCLiki: YTools

インストール方法

 上記プロジェクトページからダウンロードしてきて適当に導入します。

試してみる

 Common Lispのバッククォートの問題点として、McDermott氏は、バッククォートは、quoteのように「'」→quoteという対応がなく、展開も処理系依存のためポータブルなコードウォーカーが書きにくく、また、カスタマイズもしづらいことを挙げています。
さらに展開の難解さも指摘していて、これらを解決しようというのが、今回紹介の独自のバッククォート式です。
記法は、「!`数字」と、「,数字」「,数字@」となっていて、既存のバッククォート式が使えなくなるということはないように配慮されています。
特長としては、対応する展開レベルを数字で指定できるのでネストした場合に、どのレベルに対応して展開されるのかが分かり易い点があります。

;;; 標準
(let ((x 'xx)
      (y 'yy))
  `(,x `(,',y)))
;=>  (XX `(,'YY))

;;; ytools (let ((x 'xx) (y 'yy)) !`1(,1x `(,1y))) ;=> (XX `(YY))

;;; 標準 (let ((x 'xx) (y 'yy)) `(,x `(,',y ,,y))) ;=> (XX `(,'YY ,YY))

;;; ytools (let ((x 'xx) (y 'yy)) !`1(,1x !`2(,1y ,2y))) ;=> (XX !`2(YY ,2#Y))

;;; ytools (let ((x 'xx) (y 'yy)) !`1(,1x !`2(,1y !`3(,2x ,y)))) ;=> (XX !`2(YY !`3(,2#X YY)))

3重のネスト位になるとYToolsの方が読み易い気はします。
書く時ですが、どのレベルの内容が欲しいのか数字で指定できるので複雑なネストを書くのはかなり楽ではあります。

まとめ

 今回は、YTools: Backquoteを紹介してみました。
ネストするバッククォート式を書くことは少ないですが、上手く状況に適合した場合には楽かもしれません。
しかし、バッククォート式を返す、バッククォート式がちょっと難しい気もしますね。これも馴れなのでしょうか。

YTools: mapperの紹介

Posted 2014-12-29 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の364日目です。

YTools: mapperとはなにか

 YTools: mapperは、Drew McDermott氏のユーティリティであるYtoolsの中のmap系のユーティリティです。

パッケージ情報

パッケージ名YTools: mapper
Quicklisp×
プロジェクトページHome page for Drew McDermott
CLiKiCLiki: YTools

インストール方法

 上記プロジェクトページからダウンロードしてきて適当に導入します。

試してみる

 map系のユーティリティという括りよりは、単に短かく書ける記法なのですが、どんな風に書けるかというとこんな風に書けます。

;;; map
(<# (\\ (x) x) '(1 2 3 4))
;=>  (1 2 3 4)

;;; every (<& values '(t t t t)) ;=> T

;;; funcall (>< #'list 1) ;=> (1)

;;; apply (<< list '(1 2 3 4)) ;=> (1 2 3 4)

;;; remove-if-not (<? identity '(1 2 3 nil 4)) ;=> (1 2 3 4)

;;; reduce(複数の引数が取れる) (</ + 0 '(1 1 1 1) '(10 10 10 10)) ;=> 44

それぞれ2文字で記述できます。記述量を少なくする為か関数ではなくマクロになっていて#'を書かなくて済むようになっていますが、funcall(><)だけ例外です。
ちなみに大体想像が付くかなと思いますが\\はlambdaです。

まとめ

 今回は、YTools: mapperを紹介してみました。
最初は、2文字はさすがにないだろうと思っていましたが、しばらく使ってるうちに癖になってきてしまいました。馴れとは恐しい。

common-methodsの紹介

Posted 2014-12-28 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の363日目です。

common-methodsとはなにか

 common-methodsは、Ryan Pavlik氏作のRubyにインスパイアされたCommon Lispのメソッド定義/構成のためのライブラリです。

パッケージ情報

パッケージ名common-methods
Quicklisp×
レポジトリrpav/common-methods · GitHub

インストール方法

 Quicklispには収録されていません。
githubからダウンロードしてQuicklispのlocal-projectsに置けば

(ql:quickload :common-methods)

できるようになります。

試してみる

 以前、incongruent-methodsを紹介した時に、Orivej Desh氏よりcommon-methodsというものがあるよと教えてもらっていました。
Lisp Library 365も終盤なので紹介しておきます。

 まずcommon-methodsの機能としては、incongruent-methodsの機能をほぼ包含している感じです。
実現方法は若干違いますが、可変長引数でメソッドをディスパッチさせるのにコンパイラマクロを利用する点などは共通しています。

(cm:def* plus ((x number) (y number))
  (+ x y))

(cm:def* plus ((x string) (y string)) (concatenate 'string x y))

(plus "foo" :y "bar") ;=> "foobar"

(plus 1 :y 2) ;=> 3

(cm:def* plus (x) x)

(plus 'zoo) ;=> ZOO

 また、名前がstring=なら同一の関数として呼べるという、incongruent-methodsのdefine-shared-methodは、common-methodsでは、共有用のcm-methods(m)パッケージに定義するというのが対応しているでしょうか。

 その他の機能としては、一般的な多重ディスパッチでないオブジェクト指向システムの書き具合を再現しようとしたものが多いようです。

まとめ

 今回は、common-methodsを紹介してみました。
Common Lisp純粋主義者は気に入らないだろうと前置きがありますが、まあ他の言語の便利な機能を取り込んだり実装するのも一興ですよね。

cl-unicodeの紹介

Posted 2014-12-27 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の362日目です。

cl-unicodeとはなにか

 cl-unicodeは、Edi Weitz氏作のCommon LispでUnicodeを扱うためのライブラリです。

パッケージ情報

パッケージ名cl-unicode
Quicklisp
ドキュメントCL-UNICODE - A portable Unicode library for Common Lisp
CLiKiCLiki: cl-unicode
Quickdocscl-unicode | Quickdocs
CL Test Grid: ビルド状況cl-unicode | CL Test Grid

インストール方法

(ql:quickload :cl-unicode)

試してみる

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

 名前のとおりCommon LispでUnicodeを扱うためのライブラリです。
文字からUnicodeのプロパティを取得する等、一通りの操作が可能です。
また、Unicodeが扱える処理系でも文字の名前等は統一されていませんが、cl-unicodeを利用すれば統一的に記述できます。

(defun props (char)
  (remove-if-not (*:curry #'cl-unicode:has-property char)
                 (cl-unicode:recognized-properties)))

(props #\あ) ;=> ("Alphabetic" "Any" "Assigned" "BidiClass:L" "Block:Hiragana" "GraphemeBase" ; "Hiragana" "IDContinue" "IDStart" "L" "Lo" "XIDContinue" "XIDStart")

(mapcar #'string (cl-unicode:list-all-characters "Hiragana")) ;=> ("ぁ" "あ" "ぃ" "い" "ぅ" "う" "ぇ" "え" "ぉ" "お" "か" "が" "き" "ぎ" "く" "ぐ" "け" "げ" "こ" ; "ご" "さ" "ざ" "し" "じ" "す" "ず" "せ" "ぜ" "そ" "ぞ" "た" "だ" "ち" "ぢ" "っ" "つ" "づ" "て" ; "で" "と" "ど" "な" "に" "ぬ" "ね" "の" "は" "ば" "ぱ" "ひ" "び" "ぴ" "ふ" "ぶ" "ぷ" "へ" "べ" ; "ぺ" "ほ" "ぼ" "ぽ" "ま" "み" "む" "め" "も" "ゃ" "や" "ゅ" "ゆ" "ょ" "よ" "ら" "り" "る" "れ" ; "ろ" "ゎ" "わ" "ゐ" "ゑ" "を" "ん" "ゔ" "ゕ" "ゖ" "ゝ" "ゞ" "ゟ")

(mapcar #'string (cl-unicode:list-all-characters "Katakana")) ;=> ("ァ" "ア" "ィ" "イ" "ゥ" "ウ" "ェ" "エ" "ォ" "オ" "カ" "ガ" "キ" "ギ" "ク" "グ" "ケ" "ゲ" "コ" ; "ゴ" "サ" "ザ" "シ" "ジ" "ス" "ズ" "セ" "ゼ" "ソ" "ゾ" "タ" "ダ" "チ" "ヂ" "ッ" "ツ" "ヅ" "テ" ; "デ" "ト" "ド" "ナ" "ニ" "ヌ" "ネ" "ノ" "ハ" "バ" "パ" "ヒ" "ビ" "ピ" "フ" "ブ" "プ" "ヘ" "ベ" ; "ペ" "ホ" "ボ" "ポ" "マ" "ミ" "ム" "メ" "モ" "ャ" "ヤ" "ュ" "ユ" "ョ" "ヨ" "ラ" "リ" "ル" "レ" ; "ロ" "ヮ" "ワ" "ヰ" "ヱ" "ヲ" "ン" "ヴ" "ヵ" "ヶ" "ヷ" "ヸ" "ヹ" "ヺ" "ヽ" "ヾ" "ヿ" "ㇰ" "ㇱ" ; "ㇲ" "ㇳ" "ㇴ" "ㇵ" "ㇶ" "ㇷ" "ㇸ" "ㇹ" "ㇺ" "ㇻ" "ㇼ" "ㇽ" "ㇾ" "ㇿ" "㋐" "㋑" "㋒" "㋓" "㋔" ; "㋕" "㋖" "㋗" "㋘" "㋙" "㋚" "㋛" "㋜" "㋝" "㋞" "㋟" "㋠" "㋡" "㋢" "㋣" "㋤" "㋥" "㋦" "㋧" ; "㋨" "㋩" "㋪" "㋫" "㋬" "㋭" "㋮" "㋯" "㋰" "㋱" "㋲" "㋳" "㋴" "㋵" "㋶" "㋷" "㋸" "㋹" "㋺" ; "㋻" "㋼" "㋽" "㋾" "㌀" "㌁" "㌂" "㌃" "㌄" "㌅" "㌆" "㌇" "㌈" "㌉" "㌊" "㌋" "㌌" "㌍" "㌎" ; "㌏" "㌐" "㌑" "㌒" "㌓" "㌔" "㌕" "㌖" "㌗" "㌘" "㌙" "㌚" "㌛" "㌜" "㌝" "㌞" "㌟" "㌠" "㌡" ; "㌢" "㌣" "㌤" "㌥" "㌦" "㌧" "㌨" "㌩" "㌪" "㌫" "㌬" "㌭" "㌮" "㌯" "㌰" "㌱" "㌲" "㌳" "㌴" ; "㌵" "㌶" "㌷" "㌸" "㌹" "㌺" "㌻" "㌼" "㌽" "㌾" "㌿" "㍀" "㍁" "㍂" "㍃" "㍄" "㍅" "㍆" "㍇" ; "㍈" "㍉" "㍊" "㍋" "㍌" "㍍" "㍎" "㍏" "㍐" "㍑" "㍒" "㍓" "㍔" "㍕" "㍖" "㍗" "ヲ" "ァ" "ィ" ; "ゥ" "ェ" "ォ" "ャ" "ュ" "ョ" "ッ" "ア" "イ" "ウ" "エ" "オ" "カ" "キ" "ク" "ケ" "コ" "サ" "シ" ; "ス" "セ" "ソ" "タ" "チ" "ツ" "テ" "ト" "ナ" "ニ" "ヌ" "ネ" "ノ" "ハ" "ヒ" "フ" "ヘ" "ホ" "マ" ; "ミ" "ム" "メ" "モ" "ヤ" "ユ" "ヨ" "ラ" "リ" "ル" "レ" "ロ" "ワ" "ン")

(print #\㌍) ;>> ;>> #\SQUARE_KARORII ;=> #\SQUARE_KARORII

(cl-unicode:unicode1-name #\㌍) ;=> "SQUARED KARORII"

(cl-unicode:character-named "SQUARED KARORII") ;=> #\SQUARE_KARORII

まとめ

 今回は、cl-unicodeを紹介してみました。
名前で検索して面白い文字を見付けたりするのにも便利ですね。

lisp-executableの紹介

Posted 2014-12-26 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の361日目です。

lisp-executableとはなにか

 lisp-executableは、Mark Cox氏作のCommon Lispで実行ファイルを作るためのユーティリティです。

パッケージ情報

パッケージ名lisp-executable
Quicklisp
ドキュメントLisp Executable
CLiKiCLiki: lisp-executable
Quickdocslisp-executable | Quickdocs
CL Test Grid: ビルド状況lisp-executable | CL Test Grid

インストール方法

(ql:quickload :lisp-executable)

試してみる

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

 現在、大抵のCommon Lisp処理系は実行ファイルが作れますが、lisp-executableを利用すると、シェルから実行するコマンドを簡便に作ることが可能です。
便利なdefine-programという実行ファイルを関数のように定義する構文が用意されているのと、ASDFと統合されているのが特長です。

 こんな感じの定義と、

(defpackage :hello
  (:use :cl :lisp-executable))

(cl:in-package :hello)

(define-program hello (&options help) (cond (help (format t "Help はないよ~%")) (t (format t "おはよう日本~%"))) (terpri))

こんなasdファイルがあれば、

(cl:in-package :asdf)

(asdf:load-system :lisp-executable)

(defsystem :hello :serial t :depends-on (:lisp-executable) :components ((:file "hello") (lisp-executable:executable "hello-bin" :program ("HELLO" "HELLO"))))

asdf:oosのlisp-executable:create-executables-opを実行することで、実行可能ファイルが生成できます。

(asdf:load-system :hello)
(asdf:oos 'lisp-executable:create-executables-op :hello)

生成された実行ファイルを実行してみる

$ ./hello-bin
おはよう日本

$ ./hello-bin --help Help はないよ

まとめ

 今回は、lisp-executableを紹介してみました。
define-programがうまいことできていて非常に便利ですね。

com.informatimago.tools.pathnameの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の360日目です。

com.informatimago.tools.pathnameとはなにか

 com.informatimago.tools.pathnameは、Pascal Bourguignon氏作のパスネームを扱うライブラリです。

パッケージ情報

パッケージ名com.informatimago.tools.pathname
Quicklisp

インストール方法

(ql:quickload :com.informatimago.tools.pathname)

試してみる

 エクスポートされているのは、make-pathname、translate-logical-pathname、user-homedir-pathnameの3つですが、どれもclパッケージに定義されているものです。
何が目的なのかソースを眺めてみましたが、user-homedir-pathnameは、Windows上のCCLだとホームディレクトリを返さないという問題があるらしくそれの対処のようです。
他、make-pathnameですが、*case-common-is-not-downcased-on-posix-systems*というフラグで処理系ごとに挙動を変えています。
case-commonというのは恐らく

(make-pathname :directory "DI" :name "TILTOWAITO" :type "MOLITO"
               :case :common)
;=>  #P"/di/tiltowaito.molito"

この:case :commonだと思うのですが、Allegro CLと、Emacs CLは、POSIXシステムだと小文字になるべき所でならないようなことが読み取れます。
そうなのかと思ってAllegro CLのalisp/mlisp両方で試してみましたが、そんなこともないようです。

 ちなみにこの:case :commonですが、大文字で書くと、ファイルシステムのデフォルトのケース(Unixなら小文字)に合せてくれて、小文字ならその逆、混ぜると変換なし、というものです。
:common :caseを付けるのが正しい的な説も耳にしたことがありますが、デフォルトは:common :localだったりもしますし、ちょっと謎です。

 translate-logical-pathnameの方も謎がありますが、パスをlogical-pathnameに変換しているようなので、変換するほうが都合が良い処理系があったりするのかもしれません。

まとめ

 今回は、com.informatimago.tools.pathnameを紹介してみました。
若干謎が多いユーティリティですが、コードを眺めていて、logical-pathnameは、pathnameとは別の型が用意されていることに気付きました。
これは知らなかった…。

(type-of #p"sys:src;")
;=>  LOGICAL-PATHNAME

(type-of #p"/") ;=> PATHNAME

chirpの紹介

Posted 2014-12-24 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の359日目です。

chirpとはなにか

 chirpは、Nicolas Hafner氏作のCommon LispからTwitterを利用するためのライブラリです。

パッケージ情報

パッケージ名chirp
Quicklisp
ドキュメントサイトChirp - About
CLiKiCLiki: Chirp
Quickdocschirp | Quickdocs
CL Test Grid: ビルド状況chirp | CL Test Grid

インストール方法

(ql:quickload :chirp)

試してみる

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

 使い方はドキュメントサイトにも書いてありますが、クライアントを登録すればCommon LispからTwitterを利用できるようになります。
クライアントを登録するところからの説明はドキュメントにあるので、既にキーを取得している場合について書いてみますが、

((consumer-key "madaltohalitodialko")
 (consumer-secret "loktofeitodiostiltowaito")
 (access-key "loktofeitomahalitomadalto")
 (access-secret "maporficlahalitomakanito"))

というような内容の~/.twitter-oauth.lispがあったとすれば、

(defun chirp-init ()
  (let ((keys (with-open-file (in "~/.twitter-oauth.lisp")
                (read in))))
    (setq chirp-extra:*oauth-api-key*
          (second (assoc 'consumer-key keys))
          chirp-extra:*oauth-api-secret*
          (second (assoc 'consumer-secret keys))
          chirp-extra:*oauth-access-secret*
          (second (assoc 'access-secret keys))
          chirp-extra:*oauth-access-token*
          (second (assoc 'access-key keys))))
  (chirp:account/verify-credentials))

(chirp-init)

こんな感じで認証ができて、

(chirp:statuses/update "Charpからつぶやき。cl-twitterさよなら")

こんな感じでつぶやけます。
また、chirpは、streaming apiにも対応

(chirp:stream/user (lambda (message)
                     (when message
                       (format T
                               "~&STREAM: ~a~%"
                               (when (typep message 'chirp-objects:status)
                                 (chirp-objects:text message))))
                     T))
;>> STREAM: NIL
;>> STREAM: しかし眠い…時差ぼけ?
;...

まとめ

 今回は、chirpを紹介してみました。
自分は、Twitterは、SLIME経由で利用していますが、以前は、cl-twitterを使ってみたりしていました。
しかし、cl-twitterは、Twitter側のアップデートに追従できずに使えなくなってしまうことが多く、しょうがないのでcl-oauthを直に使ってみたりしていました。
Twitter側のAPIの変更も落ち着いたようですし、chirpはcl-twitterに比べてほど良くまとまっている感じなので使い易そうですね。

MIT LOOPの紹介

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

(LISP Library 365参加エントリ)
(Lisp Advent Calendar 2014参加エントリ)

 LISP Library 365 の358日目、Lisp Advent Calendar 2014の24日目です。

MIT LOOPとはなにか

 MIT LOOPは、MIT MacLISP系Lispの繰り返し構文です。

パッケージ情報

パッケージ名MIT LOOP
ドキュメント Glenn S. Burke, George J. Carrette, and Christopher R. Eliot. NIL Reference Manual corresponding to Release 0.286. Report MIT/LCS/TR-311, January 1984. — Software Preservation Group

インストール方法

 MacLISP系Lispでは標準で使えます。Common Lisp、MacLISP、Zetalisp、NIL、Franz Lisp等。Emacs Lispにも移植されています。

LOOPの歴史

 需要はないと思いますが、調べてみたら色々分かったことがあったのでLOOPの歴史でもまとめてみます。

Interlispから輸入(1976-1980)

 MIT LOOPはどうやら1980年から開発が開始されたようです。開発開始と同時期に(BUG LOOP)と、(INFO LOOP)いうメーリングリストが作成されバグ報告が始まります。
実は、MIT LOOPには先行する繰り返し構文が存在していて、InterlispのCLispの繰り返し構文であるFORをPeter Szolovits氏が1976年にMacLISPに再現したのが始まりで、それを整理したのが、LOOPということみたいです(バージョン124のコメントによれば)。
主要開発者は、Glenn Burke(以降GSB)氏で、1980年から1989年頃まで、ほぼ一人でバグ修正の対応や新機能の追加をしているようです。
何の役にも立たない気はしますが、メーリングリストやソースコードのコメントに出てくるバージョンと日付をメモしておきます。

  • 1980-08-20 ver. 120
  • 1981-02-13 ver. 690
  • 1981-04-07 ver. 693
  • 1982-04-08 ver. 765
  • 1982-06-01 ver. 767
  • 1983-07-21 ver. 790
  • 1984-12-07 ver. 829
  • 1986-04-30 ver. 829-gsb86
  • 1987-07-09 ver. 829-gsb87
  • 1991 ver. 829-gsb91-symbolics-ansi-cl

ちなみに手元で確認できたLOOPのバージョンは、

  • 122
  • 124
  • 716
  • 726
  • 750
  • 786
  • 789
  • 818
  • 829
  • 829-gsb86
  • 829-gsb87
  • 829-gsb91-symbolics-ansi-cl

です。何の役に立つか判りませんが、少なくともこれらバージョンのLOOPのソースは現存します。

 メーリングリストを眺めていて面白いのは、GLSが、「LOOPはあまり好きじゃないし使ったことがないけど」と言いつつ仕様の問題点の指摘(ぶらさがりdoの問題等)と、namedの提案をしていたりするところ(ブロックをnamedで指定する機能は取り込まれています)。1980年の時点で既にLOOPが好きじゃない人がいるようです。

 マニュアルは、Technical Memo 169, "LOOP Iteration Macro"が発行されていますが、後のバージョンは、NILのマニュアルに詳しく機能が説明されています。

MacLISP、Zetalisp、NIL、Franz Lispで共有(1980-1982)

 1980年当初は、どうもLispマシンがメインのプラットフォームだったようですが、すぐにMacLISPとNILでもソースコードが共有され始めます。ちょっと遅れてFranz LispがVAXのMacsymaのために移植。
丁度この時期に#+-リーダーマクロで読み込みを制御するようになったので、ソースコードも単一のものが使われていますが、当時のLispのスーパーセットのようなLSBで記述したものも存在したようです(LSBもGSB氏が関わっている)。

NILが開発の拠点となる(1983位)

 GSB氏はNILの主要開発者であるためか、一次ソースが開発されるのがNILのプロジェクトになります。
NIL自体は最終的に未完となりましたが、NILのLOOPのバージョン829が決定稿という感じで以後他の処理系でも使われます。

ベンダがCommon Lispへ拡張機能として導入しはじめる(1984)

 1984年当時決まったCommon Lisp仕様のLOOPは単なる無限ループですが、処理系が拡張機能として、NILのLOOP 829を添付することが多かったようです。
LOOP 829以外のバージョンの利用ということでは、Symbolicsは、Genera 6.1以降、LOOP 803を元にしたものをベースに改良され、TI-Explorerは何故かバージョン750位で枝分かれしたものを整理して使っていたようです。ちなみにこの頃開発が終っていたMacLISPではバージョン818が最終のようです。

GSB氏がCommon Lisp用に整理したものが共有される(1986)

 Common Lispも広まり始めた頃ですが、CLtL1な処理系のための多機能なLOOPが欲しいということだったのか、GSB氏が当時在籍していたPalladian社の仕事としてNILのLOOP 829を整理して配布します。
Lucid CLあたりがこのソースを使っていますが、何故か独自の実装も用意しています。
また、このソースは、CMUのAIレポジトリで公開されていますが、何故かANSI CL処理系のECLがこれを使っています。MCLもこちらを利用していた様子。

SymbolicsがANSI仕様に準拠させて整理したものを公開(1991)

ANSI Common Lisp対応(1991)

 ANSI CLでは、LOOPが多機能になるということがCLtL2によって広まると、ANSI CL対応のソースの需要が高まったのか、SymbolicsからNILのLOOP 829をベースにANSI CLの仕様に対応し整理されたコードが公開されます。
このバージョンのコードはヘッダにSymbolicsの署名があるので判別しやすいですが、現在メジャーなCommon Lisp処理系は、大体この実装を使っています。
作業についてのコメントもGSB氏が書いているので、当時はSymbolicsに在籍していたのかもしれません(なお在籍はしていたもののこの時期かどうかは不明)。
1986年4月のバージョンを元にしていて、GSB氏の最終バージョンではなかったようなのですが、当時それ以降のバージョンを紛失してしまったということです。
しかし、1986年4月以降のバージョンも後に見付かってCMUのレポジトリで公開されることになったようで、ちょっと捻れた関係になっていますが、ECLは一次紛失していたバージョンをベースに使ってしまっていてANSI対応は独自にしているようです。

ざっと並べると

  • SBCL
  • CMUCL
  • Allegro CL
  • Clozure CL
  • GCL
  • ABCL

がこのANSI CL仕様で整理された実装を処理系に合せて調整して利用しています。その他のものというと、CLISPが独自実装な位です。
ちなみにCLISPの実装は、CLtL2の仕様を元に作られている為、finally節でreturnが使えたりします。

(loop :for i :from 0 :to 5 :collect i :into is
      :finally :return is)
;=>  (0 1 2 3 4 5)

ANSI CLには取り込まれなかった便利構文

 NIL LOOP 829とANSI CL LOOPの違いですが、:across節の導入と、ユーザーがLOOPをカスタマイズできる機能の廃止が主なところです。
文章ばかりだったので、ここで廃止された機能を俯瞰してみましょう。

シークエンスで範囲指定

(loop :for e :being :the :elements :of (*:iota 100) :from 5 :to 10
      :collect e)
;=>  (5 6 7 8 9 10)

こんな感じに、fromとtoで範囲が指定可能です。まあ、subseqと組み合せれば済むのですが、あれば便利そうです。

シークエンスを逆順で処理

(loop :for e :being :the :elements :in '(a b c d e f g h) :downto 0
      :collect e)
;=>  (H G F E D C B A)

downtoで指定した位置まで逆順で処理します。あまり使わなそうですがインパクトはあります。

添字を自動生成

 using indexで添字を生成できます。

(loop :for e :being :the :elements :of '(a b c d e f g h) :using (:index i)
      :collect (cons i e))
;=>  ((0 . A) (1 . B) (2 . C) (3 . D) (4 . E) (5 . F) (6 . G) (7 . H))

これも添字用のfor節を作れば良いのですが、あったら便利な気はします。

その他のloop-path

 LOOP内で処理する流れをloop-pathと呼ぶのですが、初期のバージョン以降ですぐ廃止になったloop-pathを紹介しておきます。

(loop :for d :being :the :cdrs :of (*:iota 5)
      :collect d)
;=>  ((2 3 4) (3 4) (4) NIL)

(loop :for a :being :cars :of '((((1 2) 3) 4) 5) :collect a) ;=> (((1 2) 3) (1 2) 1)

(loop :for a :being '((((1 2) 3) 4) 5) :and :its :car :collect a) ;=> ((((1 2) 3) 4) ((1 2) 3) (1 2) 1)

 being the cdrsはonで実現できますが、being the carsはcarの方向に進んで行くもので、これは後のLOOPの機能にはありません。ちなみに、cddrもあります。
なお、上記の実行結果を眺めると判りますが、being ... and its ...の方は包含的な動作になります。

ユーザーによる機能拡張

 ユーザーによる機能拡張の構文は、3つあり、ユーザーがLOOPの別名を付けることができるdefine-loop-macro、ユーザーがloop-pathを定義できるdefine-loop-pathと、シークエンス専用のdefine-loop-sequence-pathがあります。

define-loop-macro

 define-loop-macroの方は、LOOP節と同じ名前で定義することで最初の節のキーワードを省略することが可能です。

(define-loop-macro for)

(define-loop-macro repeat)

(define-loop-macro with)

(for i :from 0 :to 5 :collect i) ;=> (0 1 2 3 4 5)

(repeat 8 :collect nil) ;=> (NIL NIL NIL NIL NIL NIL NIL NIL)

(with a := t :repeat 5 :collect a) ;=> (T T T T T)

この機能ですが、InterlispのFORはfor、do、collect、with等で書き始められるので、この辺りをサポートしようとしたのではないかと推測しています。
但し、InterlispのFORでは、

(collect x :for x :from 0 :to 8)

のようなことも可能ですが、LOOPでは別名を定義してもできません。

define-loop-path

 define-loop-pathですが、例として初期で廃止になったcarとcdrのloop-pathを定義してみます。

(defmacro loop-lookup-keyword (item x)
  `(assoc ,item ,x :test #'string-equal))

(defun loop-path-carcdr (name var dtype pps inclusive? preps data) (declare (ignore preps)) (let ((vars) (step) (endtest `(,(cadr data) ,var)) (tem)) (or (setq tem (loop-lookup-keyword 'of pps)) (error "No initialization given for ~S path" name)) (setq vars `((,var ,(cond (inclusive? (cadr tem)) (t `(,(car data) ,(cadr tem)))) ,dtype))) (setq step `(,var (,(car data) ,var))) (list vars nil nil nil endtest step)))

(define-loop-path (cdr cdrs) loop-path-carcdr (of) cdr atom)

(define-loop-path (car cars) loop-path-carcdr (of) car atom)

(define-loop-path (cddr cddrs) loop-path-carcdr (of) cddr null)

こんな感じのコードの追加で、上記の「その他のloop-path」で出てきたコードの動作になります。

define-loop-sequence-path

 define-loop-sequence-pathは、

(define-loop-sequence-path (schar schars) schar length simple-string
  (or null character))

(loop :for c :being :each :schar :of "Temp String" :for i :from 0 :collect (list i c)) ;=> ((0 #\T) (1 #\e) (2 #\m) (3 #\p) (4 #\ ) (5 #\S) (6 #\t) (7 #\r) (8 #\i) ; (9 #\n) (10 #\g))

こんな感じのものを定義することが可能です。

 ANSI CL対応版でもdefine-loop-pathより低レベルの拡張APIは用意されているので拡張することは可能ですが、どうも面倒です。
ANSI CL対応版のおまけで拡張用のコードも付属していたのですが、拡張用のコードが動かないので広まらなかったのかもしれません。この辺がちょっと残念です。
ちなみにANSI CL対応版での拡張では、SBCLのiterator protocol対応で、being the elements ofが使えるようになっているものと、Allegro CLで、sequence用に、in-sequenceが使えるようになっているものがあります。また、clsql等で独自のloop-pathを定義している例もあったりはします。

まとめ

 今回は、MIT LOOPを紹介してみました。
調べてみればこの34年位でLOOPマクロの実装は殆どの処理系で同じものが使われていたというのが意外でした。
CLtL1以後、Common Lispの繰り返しについて議論するワーキンググループがあり、そのまとめはJonL White氏がCLtL2に書いているので、JohnL氏あたりが中心となって開発しているのかと思っていましたが、実際のところは、GSB氏ほぼ一人がかなりの割合で面倒を見ていたというのも意外でした。
LOOPマクロはGSB氏の作品といっても良いような気もします。

latchの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の357日目です。

latchとはなにか

 latchは、Felix Winkelmann氏作の評価を一度きりに限定する構文です。

パッケージ情報

パッケージ名latch
Chicken eggs:latch - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install latch

すれば、

(use latch)

で使えます。

試してみる

 Common Lispでいうdefvarみたいなものかなと思いましたが、letの構文になっていて、letの体裁ならば、元々多重に評価されることもなさそうなので謎です。
もしや束縛部の値側のフォームが同じなら使い回すのだろうかと思ってマクロを展開して眺めてみるも、そのようなところもなく…

(##core#let ((g542 (quote538 #(#%novalue)))
             (g543 (quote538 #(#%novalue)))
             (g544 (quote538 #(#%novalue))))
  (let537
    ((r0 (let537 ((tmp539 (##sys#slot g542 0)))
           (if541 (eq?540 (quote538 #%novalue) tmp539)
                  (let537 ((tmp539 (make-list 300 0)))
                    (##sys#setslot g542 0 tmp539)
                    tmp539)
                  tmp539)))
     (r1 (let537 ((tmp539 (##sys#slot g543 0)))
           (if541 (eq?540 (quote538 #%novalue) tmp539)
                  (let537 ((tmp539 (make-list 300 0)))
                    (##sys#setslot g543 0 tmp539)
                    tmp539)
                  tmp539)))
     (r2 (let537 ((tmp539 (##sys#slot g544 0)))
           (if541 (eq?540 (quote538 #%novalue) tmp539)
                  (let537 ((tmp539 (make-list 300 1)))
                    (##sys#setslot g544 0 tmp539)
                    tmp539)
                  tmp539))))
    (car r0)))

 とりあえず使い方としては下記の通りです。

(let*-once ((r (make-list 300 0)))
  (car r))
;=> 0

(let*-once ((r0 (make-list 300 0)) (r1 (cons 0 r0))) (car r0)) ;=> 0

まとめ

 今回は、latchを紹介してみました。
何か処理系固有の事情があったりするのでしょうか。

com.informatimago.clext.closer-weakの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の356日目です。

com.informatimago.clext.closer-weakとはなにか

 com.informatimago.clext.closer-weakは、Pascal Bourguignon氏作のCommon Lispで弱参照を扱うためのライブラリです。CLISPの弱参照のAPIを参考にポータブルに実現したもののようです。

パッケージ情報

パッケージ名com.informatimago.clext.closer-weak
Quicklisp

インストール方法

(ql:quickload :com.informatimago.clext)

試してみる

 以前CLISPの弱参照のライブラリを紹介しましたが、

このAPIを踏襲しています。
処理系の対応具合は、ドキュメントによれば、

             WP   WL   WAR WOR WM  WHT
  allegro   
  ccl         x    x    x       x   n   -- WHT native.
  clisp       n    n    n   n   n   n   -- full support - native
  cmucl       n    x    x       x   x   -- partial support (missing WEAK-OR-RELATION)
  sbcl        n    x    x       x   x   -- partial support (missing WEAK-OR-RELATION)

とのこと(xがサポート、空白が未対応、nが処理系がネイティブにサポートしているもの)
ということでSBCLで試してみます。

(*:list-external-symbols :com.informatimago.clext.closer-weak)

(defun gc () (sb-ext:gc :full T))

(defvar *wp* (make-weak-pointer (list 1)))

(weak-pointer-value *wp*) ;=> (1) ; T (gc) ;=> NIL

*wp* ;=> #<broken weak pointer>

(weak-pointer-value *wp*) ;=> NIL ; NIL

(defvar *a* (list 'a))

(defvar *weak-list* (make-weak-list (list *a* (list 'b) (list 'c)))) ;=> *WEAK-LIST*

(weak-list-list *weak-list*) ;=> ((A) (B) (C))

(gc) ;=> NIL

*weak-list* ;=> #S(WEAK-LIST ; :HEAD (#<weak pointer: (A)> #<broken weak pointer> #<broken weak pointer>))

(weak-list-list *weak-list*) ;=> ((A))

(defvar *a* (list 'a))

(defvar *weak-and* (make-weak-and-relation (list *a* (list 'b) (list 'c)))) ;=> *WEAK-AND*

*weak-and* ;=> #S(WEAK-AND-RELATION ; :OBJECTS #(#<weak pointer: (A)> #<weak pointer: (B)> #<weak pointer: (C)>))

(gc) ;=> NIL

*weak-and* ;=> #S(WEAK-AND-RELATION ; :OBJECTS #(#<weak pointer: (A)> #<broken weak pointer> ; #<broken weak pointer>))

(defvar *weak-or* (make-weak-or-relation (list *a* (list 'b) (list 'c)))) ;=> *WEAK-OR*

(gc) ;=> NIL

*weak-or* ;=> #S(WEAK-OR-RELATION :OBJECTS #((A) (B) (C)))

(defvar *key* (list 1))

(defvar *wa* (make-weak-mapping *key* :value)) ;=> *WA*

(weak-mapping-value *wa*) ;=> :VALUE

(setq *key* nil) ;=> NIL

(gc) ;=> NIL

*wa* ;=> #S(WEAK-MAPPING :KEY #<broken weak pointer> :VALUE :VALUE)

(weak-mapping-value *wa*) ;=> NIL

動作を眺める限り、weak-or-relationが未対応というよりweak-and-relationが未完成のように見えますがどうなのでしょう。コードのコメントによればCMUCLとSBCLはこの辺りの対応が弱いようです。

まとめ

 今回は、com.informatimago.clext.closer-weakを紹介してみました。
この辺りの機能は大体どの処理系も横並びなのかと思っていましたが、CLISPの充実度合いが光ります。

generic-sequencesの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の355日目です。

generic-sequencesとはなにか

 generic-sequencesは、David Sorokin氏作のC#、F#、Scalaのシークエンスのように、リスト、遅延ストリーム、イテレータを統合したシークエンスを提供するものです。

パッケージ情報

パッケージ名generic-sequences
Quicklisp
Quickdocsgeneric-sequences | Quickdocs
CL Test Grid: ビルド状況generic-sequences | CL Test Grid

インストール方法

(ql:quickload :generic-sequences)

試してみる

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

 定義されているものは、こんな感じです。

  • delay-seq
  • enum-append
  • enum-car
  • enum-cdr
  • enum-cons
  • make-seq
  • seq
  • seq->list
  • seq->vector
  • seq-append
  • seq-car
  • seq-cdr
  • seq-compare
  • seq-cons
  • seq-count
  • seq-count-if
  • seq-count-if-not
  • seq-cycle
  • seq-drop
  • seq-drop-while
  • seq-drop-while-not
  • seq-elt
  • seq-enum
  • seq-equal
  • seq-every
  • seq-find
  • seq-find-if
  • seq-find-if-not
  • seq-foreach
  • seq-interpose
  • seq-iterate
  • seq-length
  • seq-map
  • seq-mappend
  • seq-member
  • seq-member-if
  • seq-member-if-not
  • seq-notany
  • seq-notevery
  • seq-null
  • seq-position
  • seq-position-if
  • seq-position-if-not
  • seq-range
  • seq-reduce
  • seq-remove
  • seq-remove-if
  • seq-remove-if-not
  • seq-repeat
  • seq-repeatedly
  • seq-some
  • seq-split
  • seq-split-if
  • seq-split-if-not
  • seq-take
  • seq-take-nth
  • seq-take-while
  • seq-take-while-not
  • seq-zip
  • seqp

今時の言語のシークエンスライブラリに収録されているような関数が多いので大体使い方も想像できますが、割合にClojureっぽい気もします。

(use-package :gen-seq)

(seq->list #(0 1 2 3)) ;=> (0 1 2 3)

(seq->list (seq-take 4 (seq-append '(0 1 2) #(3 4 5)))) ;=> (0 1 2 3)

(seq->list (seq-take 5 (seq-iterate #'1+ 100))) ;=> (100 101 102 103 104)

(coerce (seq->vector (seq-reduce #'seq-append (seq-interpose "," '("お" "は" "よ" "う" "日本")))) 'string) ;=> "お,は,よ,う,日本"

(seq->list (seq-take 5 (seq-cycle '(0)))) ;=> (0 0 0 0 0)

ジェネレータ的な動作や、iterateマクロとの連携等、多機能です。
詳細はPDFのマニュアルが付属して来ますので、そちらを参照のこと。

まとめ

 今回は、generic-sequencesを紹介してみました。
seq-という接頭辞がやや煩わしいですが、既存のものと併用するばあい接頭辞がないと混乱するような気もします。

com.informatimago.tools.manifestの紹介

Posted 2014-12-18 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の353日目です。

com.informatimago.tools.manifestとはなにか

 com.informatimago.tools.manifestは、Pascal Bourguignon氏作のシステムの目録を作成するユーティリティです。

パッケージ情報

パッケージ名com.informatimago.tools.manifest
Quicklisp

インストール方法

(ql:quickload :com.informatimago.tools.manifest)

試してみる

 エクスポートされているシンボルは下記の通りですが、このうちで主なものはprint-manifestとwrite-manifestで、他はこれらの補助関数のようです。

  • asdf-system-license
  • asdf-system-name
  • distribution
  • executable-filename
  • executable-name
  • lisp-implementation-type-keyword
  • machine-type-keyword
  • print-manifest
  • system-depends-on
  • system-depends-on/recursive
  • write-manifest

 print-manifestは現在ロードされているsystemとホスト情報を目録にします。

(com.informatimago.tools.manifest:print-manifest :cl-ppcre)
;>>  date                        : 2014-11-20 16:34:26 -0900
;>>  lisp-implementation-type    : SBCL
;>>  lisp-implementation-version : 1.2.5
;>>  machine-type                : X86-64
;>>  machine-version             : Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz
;>>  machine-instance            : t
;>>  distribution                : (LINUX DEBIAN jessie/sid)
;>>  
;>>  System    License
;>>  --------  -----
;>>  cl-ppcre  BSD-2
;>>  --------  -----
;>>  
;=>  NIL

(com.informatimago.tools.manifest:print-manifest :com.informatimago.tools.manifest) ;>> date : 2014-11-20 15:50:34 -0900 ;>> lisp-implementation-type : SBCL ;>> lisp-implementation-version : 1.2.5 ;>> machine-type : X86-64 ;>> machine-version : Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz ;>> machine-instance : t ;>> distribution : (LINUX DEBIAN jessie/sid) ;>> ;>> System License ;>> -------------------------------- ----- ;>> com.informatimago.tools.manifest AGPL3 ;>> -------------------------------- ----- ;>> ;=> NIL

 write-manifestの方は、ファイルに書き出しますが、

システム名-処理系-バージョン-OS-OSのディストリビューション-マシンのアーキテクチャ.manifest

となっています。

(let ((*default-pathname-defaults* #p"/tmp/"))
  (com.informatimago.tools.manifest:write-manifest :com.informatimago.tools.manifest
                                                   :com.informatimago.tools.manifest))
Manifest for com.informatimago.tools.manifest-sbcl-1.2.5-linux-debian-jessie/sid-x86-64
---------------------------------------------------------------------------------------

date : 2014-11-20 16:28:45 -0900 lisp-implementation-type : SBCL lisp-implementation-version : 1.2.5 machine-type : X86-64 machine-version : Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz machine-instance : t distribution : (LINUX DEBIAN jessie/sid)

System License -------------------------------- ----- com.informatimago.tools.manifest AGPL3 -------------------------------- -----

こんな感じに書き出されますが、上記の場合、ディストリビューション名にスラッシュが入っていてこれが排除されていないためディレクトリが作成できないというエラーになるのはご愛嬌。

まとめ

 今回は、com.informatimago.tools.manifestを紹介してみました。稼動しているsystemを確認したい時には便利そうですね。

cl-unificationの紹介

Posted 2014-12-17 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の352日目です。

cl-unificationとはなにか

 cl-unificationは、Marco Antoniotti氏作のCommon Lispでユニフィケーションを実現するライブラリです。

パッケージ情報

パッケージ名cl-unification
Quicklisp
CLiKiCLiki: cl-unification
Quickdocscl-unification | Quickdocs
common-lisp.netcl-unification
CL Test Grid: ビルド状況cl-unification | CL Test Grid

インストール方法

(ql:quickload :cl-unification)

試してみる

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

 基本的な構造はシンプルで、ユニファイする変数と環境を指定するとマッチした結果が取得できます。

(unify 42 42)
;=>  #<EMPTY UNIFY ENVIRONMENT: 1 frame {101BFAA993}>

(let ((env (unify #T(number ?x) 42))) (find-variable-value '?x env)) ;=> 42 ; T

(let ((env (unify (list 1 '?y 3) (list '?x 2 '?z)))) (list (find-variable-value '?x env) (find-variable-value '?y env) (find-variable-value '?z env))) ;=> (1 2 3)

 マッチにはテンプレートを利用できて、複合したデータ構造もこれを指定すればマッチ可能です。

(let* ((env (unify #T(number ?x) 42))
       (env (unify #T(number ?y)
                   (find-variable-value '?x env)
                   env)))
  (list (find-variable-value '?x env)
        (find-variable-value '?y env)))
;=>  (42 42)

(defclass makanito () ((a :accessor a) (b :accessor b)))

(defvar *obj* (make-instance 'makanito))

(setf (a *obj*) 42 (b *obj*) 43)

(describe *obj*) ;>> #<MAKANITO {10203724D3}> ;>> [standard-object] ;>> ;>> Slots with :INSTANCE allocation: ;>> A = 42 ;>> B = 43 ;>> ;=> <no values>

(let ((env (unify #T(makanito a ?a b ?b) *obj*))) (list (v? '?a env) (v? '?b env))) ;=> (42 43)

#Tというのがテンプレート用のリーダーマクロでデータ型名とスロットを指定します。
また、expression-templateというものの場合、読み出し手続きの結果として値が返ってきます。

(let ((env (unify (*:iota 100) #T(elt 3 ?x))))
  (find-variable-value '?x env))
;=>  3
;    T

 さらに、制御構文としてパタンで分岐する各種matchがあります。

(defun h (op a b)
  (match-case ((list op a b))
    ('(+ 
       #T(number ?M)
       #T(number ?N))
     (+ M N))
    ('(+ 0 ?F)  F)
    ('(+ ?F 0)  F)
    ('(+ ?A (+ ?B ?C))  (h '+ (h '+ A B) C))
    ((list '*
           #T(number ?M)
           #T(number ?N))
     (* M N))
    ('(* 0 ?F)  0)
    ('(* ?F 0)  0)
    ('(* ?F 1)  F)
    ('(* 1 ?F)  F)
    ('(* ?A (* ?B ?C))  (h '* (h '* A B) C))
    ('(?Op ?A ?B)  (list Op A B))))

(defun harropify (x) (match-case (x) ('(?Op ?A ?B) (h Op (harropify A) (harropify B))) (?A A)))

(harropify '(* (+ 1 2) (+ (* x 0) y))) ;=> (* 3 Y)

まとめ

 今回は、cl-unificationを紹介してみました。
双方向マッチを使わないとあまり旨味がない気がしますが、テンプレートを拡張できるのは便利ですね。

Allegro CL: LLの紹介

Posted 2014-12-16 15:00:00 GMT

(LISP Library 365参加エントリ)
(Lisp Advent Calendar 2014参加エントリ)

 LISP Library 365 の351日目、Lisp Advent Calendar 2014の17日目です。

Allegro CL: LLとはなにか

 Allegro CL: LLは、Allegro CLで低レベルを記述する仕組みです。

パッケージ情報

パッケージ名Allegro CL: LL
ドキュメントILC 2007 Tutorial: Optimizing and Debugging Programs in Allegro CL - LL

インストール方法

 Allegro CL標準の機能です。compilerパッケージに定義されているようです。

試してみる

 LLというのは、何の略なのかというところですが、`attempt to perform low-level compiler-only :+ operation on NIL.'というエラーメッセージが出るところからすると、Low-Levelの略でしょうか。
Allegro CLにはLAPを直に書く機能もありますが、LLは、もう少しLispの世界と行ったり来たりがしやすくありつつ、インストラクションには大体1対1で対応した命令があるようです。なお、キャリーフラグ等の状態も取得できます。詳細は上記リンクの文献を参照してください。
ということで、簡単なコードでも書いてみます。

 以前、SBCLでVOPの実験をした時にfactの高速化を試みたことがありましたが、繰り返しでfactを書いてdisassembleしてみたところ、SBCLと同様に、繰り返し内でimulする度にfixnumと即値を変換していたので、これを出入口で一つにまとめてみたいと思います。

(defun fact-loop (n)
  (declare (optimize speed (safety 0) (debug 0)))
  (declare (fixnum n))
  (prog ((a 1))
        (declare (fixnum a))
     L0 (cond ((zerop n)
               (go L1 )))
        (setq a (* a n))
        (decf n)
        (go L0)
     L1 (return a)))

(fact-loop 30) ;=> 458793068007522304

;; code start: #x1002a140d8: 0: 49 c7 c5 08 00 movq r13,$8 ; 1 00 00 7: eb 0c jmp 21 9: 49 c1 fd 03 sar r13,$3 13: 4c 0f af ef imulq r13,rdi 17: 48 83 ef 08 sub rdi,$8 21: 48 83 ff 00 cmp rdi,$0 25: 75 ee jnz 9 27: 49 8b fd movq rdi,r13 30: f8 clc 31: 4c 8b 74 24 10 movq r14,[rsp+16] 36: c3 ret 37: 90 nop

 これをLLを使ってこんな感じに書いてみました。

(defun fact-loop/ (n)
  (declare (optimize speed (safety 0) (debug 0)))
  (declare (fixnum n))
  (prog ((a (comp::ll :fixnum-to-mi 1))
         (n (comp::ll :fixnum-to-mi n)))
     L0 (cond ((comp::ll := 0 n)
               (go L1 )))
        (setq a (comp::ll :* a n))
        (setq n (comp::ll :- n (comp::ll :fixnum-to-mi 1)))
        (go L0)
     L1 (return (comp::ll :mi-to-fixnum a))))

;; disassembly of #<Function FACT-LOOP/> ;; formals: N ;; code start: #x1001084a98: 0: 49 c7 c5 01 00 movq r13,$1 00 00 7: 48 c1 ff 03 sar rdi,$3 11: eb 08 jmp 21 13: 4c 0f af ef imulq r13,rdi 17: 48 83 ef 01 sub rdi,$1 21: 48 83 ff 00 cmp rdi,$0 25: 75 f2 jnz 13 27: 49 8b fd movq rdi,r13 30: 48 c1 e7 03 sal rdi,$3 34: f8 clc 35: 4c 8b 74 24 10 movq r14,[rsp+16] 40: c3 ret 41: 90 nop

 速度を比べてみます。

(dotimes (i (expt 10 8))
  (fact-loop 60))
;=> NIL
#|------------------------------------------------------------|
; cpu time (non-gc) 5.516000 sec user, 0.000000 sec system
; cpu time (gc)     0.000000 sec user, 0.000000 sec system
; cpu time (total)  5.516000 sec user, 0.000000 sec system
; real time  5.516957 sec
; space allocation:
;  54 cons cells, 5,232 other bytes, 0 static bytes
x86_64
 |------------------------------------------------------------|#

(dotimes (i (expt 10 8)) (fact-loop/ 60)) ;=> NIL #|------------------------------------------------------------| ; cpu time (non-gc) 3.640000 sec user, 0.000000 sec system ; cpu time (gc) 0.000000 sec user, 0.000000 sec system ; cpu time (total) 3.640000 sec user, 0.000000 sec system ; real time 3.640540 sec ; space allocation: ; 27 cons cells, 2,640 other bytes, 0 static bytes x86_64 |------------------------------------------------------------|#

少し速くなりました。

まとめ

 今回は、Allegro CL: LLを紹介してみました。
SBCL/CMUCLのVOPより手軽に使えて書き易い気がしました。通常の式と混ぜられるのが良いですね。
明日のLisp Advent Calendar 2014は、@y2q_actionmanさんです。お楽しみに。

jsminの紹介

Posted 2014-12-15 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の350日目です。

jsminとはなにか

 jsminは、Mario Domenech Goulart氏作のJavaScriptを圧縮するユーティリティです。Douglas Crockford氏のjsminを移植したものとのこと。

パッケージ情報

パッケージ名jsmin
Chicken eggs:jsmin - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install jsmin

すれば、

(use jsmin)

で使えます。

試してみる

 構成は非常にシンプルで、jsmin-stringと、jsmin-fileの2つのみ。
その名の通り、jsmin-stringは文字列を、jsmin-fileはファイルを変換します。

(jsmin-string "function fib (n) {
    if (n < 2) {
        return n;
    } else {
        return fib(n - 1) + fib(n - 2);
    }
}")
;=> "\nfunction fib(n){if(n<2){return n;}else{return fib(n-1)+fib(n-2);}}"

まとめ

 今回は、jsminを紹介してみました。
150行程みたいなので、他の処理系やLisp方言に移植するのも簡単そうですね。

inotifyの紹介

Posted 2014-12-14 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の349日目です。

inotifyとはなにか

 inotifyは、Olof-Joachim Frahm氏作のLinuxのファイルシステムイベントを監視するinotifyをCommon Lispから利用可能にするライブラリです。

パッケージ情報

パッケージ名inotify
Quicklisp
Quickdocsinotify | Quickdocs
CL Test Grid: ビルド状況inotify | CL Test Grid

インストール方法

(ql:quickload :inotify)

試してみる

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

 使い方はシンプルで、with-inotify内でイベントを監視します。

(inotify:with-inotify (inot `((#P"/tmp/" ,inotify:in-create)))
  (inotify:read-events inot))

; and ... (with-open-file (out "/tmp/bar" :if-does-not-exist :create))

;=> (#S(INOTIFY:EVENT ; :WATCH #<INOTIFY:WATCH pathname: #P"/tmp/" mask: (IN-CREATE)> ; :MASK (INOTIFY:IN-CREATE) ; :COOKIE 0 ; :NAME "bar"))

上記のように監視中に指定の場所でイベントが発生(上記の場合書き込み)すると通知されます。
タイムアウトも指定可

(inotify:with-inotify (inot `((#P"/tmp/" ,inotify:in-create)))
  (inotify:read-events inot :time-out 1))
;=>  NIL

まとめ

 今回は、inotifyを紹介してみました。
Linuxのファイルシステムがこういうものをサポートしていたとは知りませんでしたが、これは便利ですね。

yaclmlの紹介

Posted 2014-12-13 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の348日目です。

yaclmlとはなにか

 yaclmlは、Marco Baringer氏作のHTMLテンプレートエンジンです。

パッケージ情報

パッケージ名yaclml
Quicklisp
CLiKiCLiki: yaclml
Quickdocsyaclml | Quickdocs
CL Test Grid: ビルド状況yaclml | CL Test Grid

インストール方法

(ql:quickload :yaclml)

試してみる

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

 Common LispのHTMLテンプレートエンジンには色々ありますが、cl-whoあたりがメジャーなところでしょうか。
やはりLispなのでS式で書きたいわけなのですが、yaclmlは、デザイナーにも優しいことも設計目標の一つらしいです。

 HTMLタグをキーワードシンボルで表現するcl-who等と違って

(<:tag ...)

 という風にHTML風の<パッケージにタグを定義していきます。
タグは関数/マクロになっているのでユーザーの拡張も簡単です。
こんな感じに書いたテンプレートがあったとすると、

(<:html
 (<:body
  (<:table
   (let ((col 0))
     (<:tr (<:td [~(incf col)]) (<:td [~(incf col)]) (<:td [~(incf col)]))
     (<:tr (<:td "foo") (<:td ["bar"]) (<:td "3"))))
  (<::unordered-list2 "foo" "bar" "baz")))

 これをこんな感じに呼び出せば、

(defmacro <::unordered-list (&body list)
  `(<:ul ,@(mapcar (lambda (x) `(<:li ,x)) list)))

(yaclml:with-yaclml-stream *standard-output* (with-open-file (in "/var/tmp/yaclml.lisp") (let ((*readtable* (copy-readtable nil))) (yaclml:enable-yaclml-syntax) (eval (read in))))) ;>> <html ;>> ><body ;>> ><table ;>> ><tr ;>> ><td ;>> >1</td ;>> ><td ;>> >2</td ;>> ><td ;>> >3</td ;>> ></tr ;>> ><tr ;>> ><td ;>> >foo</td ;>> ><td ;>> >&quot;bar&quot;</td ;>> ><td ;>> >3</td ;>> ></tr ;>> ></table ;>> ><ul ;>> ><li ;>> >foo</li ;>> ><li ;>> >bar</li ;>> ><li ;>> >baz</li ;>> ></ul ;>> ></body ;>> ></html ;>> > ;=> <no values>

という感じに出力されます。

 テンプレートの方はTALという名前らしいですが、「[」から「]」の間で、

  • 「~」 → Lisp式を評価して表示
  • 「"」 → quot;に置換
  • 「$」 変数を評価(表示はなし)
  • 「@」 リストを展開(表示はなし)

の特殊文字が使えます。

まとめ

 今回は、yaclmlを紹介してみました。
このブログもyaclmlで書いていますが、拡張はしやすい気はしています。

リストの最後にpushする

Posted 2014-12-13 14:59:00 GMT

 リストの構造的に最後に要素を追加するということはあまり無い訳ですが、リストの最後にpushするというイディオムもまた、ぱっとしたものはないなあと思った次第。
なんとなく、nconcのことが多い気もします。

(let ((x (*:iota 10)))
  (push :foo (cdr (last x)))
  x)
;=>  (0 1 2 3 4 5 6 7 8 9 :FOO)

(let ((x (*:iota 10))) (setf (cdr (last x)) (list :foo)) x) ;=> (0 1 2 3 4 5 6 7 8 9 :FOO)

(define-modify-macro nconcf (&rest lists) nconc)

(let ((x (*:iota 10))) (nconcf x (list :foo)) x) ;=> (0 1 2 3 4 5 6 7 8 9 :FOO)

com.informatimago.tools.symbolの紹介

Posted 2014-12-11 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の346日目です。

com.informatimago.tools.symbolとはなにか

 com.informatimago.tools.symbolは、Pascal Bourguignon氏作のシンボルを扱うユーティリティです。

パッケージ情報

パッケージ名com.informatimago.tools.symbol
Quicklisp

インストール方法

(ql:quickload :com.informatimago.tools.symbol)

試してみる

 現在のところ定義されているのは2つの関数のみで、check-duplicate-symbolsと、duplicate-symbolsがあります。

(com.informatimago.tools.symbol:duplicate-symbols
 :packages (mapcar #'find-package '(:cl :arc)))
;=>  ((ARC:WRITE WRITE) (ARC:WHEN WHEN) (ARC:UNLESS UNLESS) (ARC:UNION UNION)
;     (ARC:TYPE TYPE) (ARC:TIME TIME) (ARC:THROW THROW) (ARC:TAN TAN)
;     (ARC:SUBST SUBST) (ARC:STRING STRING) (ARC:SORT SORT) (ARC:SLEEP SLEEP)
;     (ARC:SIN SIN) (ARC:SET SET) (ARC:REM REM) (ARC:REDUCE REDUCE) (ARC:READ READ)
;     (ARC:PUSHNEW PUSHNEW) (ARC:OR OR) (ARC:NUMBER NUMBER) (ARC:NTHCDR NTHCDR)
;     (ARC:MISMATCH MISMATCH) (ARC:MIN MIN) (ARC:MERGE MERGE) (ARC:MAX MAX)
;     (ARC:MAP MAP) (ARC:LOOP LOOP) (ARC:LOG LOG) (ARC:LIST LIST) (ARC:LET LET)
;     (ARC:LAST LAST) (ARC:IF IF) (ARC:GET GET) (ARC:FIND FIND)
;     (ARC:DO
;       DO)
;     (ARC:COUNT COUNT) (ARC:COS COS) (ARC:CONS CONS) (ARC:COMPLEMENT COMPLEMENT)
;     (ARC:COERCE COERCE) (ARC:CHAR CHAR) (ARC:CDDR CDDR) (ARC:CATCH CATCH)
;     (ARC:CASE CASE) (ARC:CADR CADR) (ARC:CAAR CAAR) (ARC:ATOM ATOM)
;     (ARC:ASSOC ASSOC) (ARC:ASSERT ASSERT) (ARC:APPLY APPLY) (ARC:AND AND)
;     (ARC:ADJOIN ADJOIN) (ARC:ACONS ACONS) (ARC:>= >=) (ARC:> >) (ARC:= =)
;     (ARC:<= <=) (ARC:< <) (ARC:++ ++) (ARC:+ +))

(com.informatimago.tools.symbol:check-duplicate-symbols :packages (mapcar #'find-package '(:cl :arc))) ;>> ((ARC:WRITE CL:WRITE) (ARC:WHEN CL:WHEN) (ARC:UNLESS CL:UNLESS) ;>> (ARC:UNION CL:UNION) (ARC:TYPE CL:TYPE) (ARC:TIME CL:TIME) ;>> (ARC:THROW CL:THROW) (ARC:TAN CL:TAN) (ARC:SUBST CL:SUBST) ;>> (ARC:STRING CL:STRING) (ARC:SORT CL:SORT) (ARC:SLEEP CL:SLEEP) ;>> (ARC:SIN CL:SIN) (ARC:SET CL:SET) (ARC:REM CL:REM) (ARC:REDUCE CL:REDUCE) ;>> (ARC:READ CL:READ) (ARC:PUSHNEW CL:PUSHNEW) (ARC:OR CL:OR) ;>> (ARC:NUMBER CL:NUMBER) (ARC:NTHCDR CL:NTHCDR) (ARC:MISMATCH CL:MISMATCH) ;>> (ARC:MIN CL:MIN) (ARC:MERGE CL:MERGE) (ARC:MAX CL:MAX) (ARC:MAP CL:MAP) ;>> (ARC:LOOP CL:LOOP) (ARC:LOG CL:LOG) (ARC:LIST CL:LIST) (ARC:LET CL:LET) ;>> (ARC:LAST CL:LAST) (ARC:IF CL:IF) (ARC:GET CL:GET) (ARC:FIND CL:FIND) ;>> (ARC:DO ;>> CL:DO) ;>> (ARC:COUNT CL:COUNT) (ARC:COS CL:COS) (ARC:CONS CL:CONS) ;>> (ARC:COMPLEMENT CL:COMPLEMENT) (ARC:COERCE CL:COERCE) (ARC:CHAR CL:CHAR) ;>> (ARC:CDDR CL:CDDR) (ARC:CATCH CL:CATCH) (ARC:CASE CL:CASE) (ARC:CADR CL:CADR) ;>> (ARC:CAAR CL:CAAR) (ARC:ATOM CL:ATOM) (ARC:ASSOC CL:ASSOC) ;>> (ARC:ASSERT CL:ASSERT) (ARC:APPLY CL:APPLY) (ARC:AND CL:AND) ;>> (ARC:ADJOIN CL:ADJOIN) (ARC:ACONS CL:ACONS) (ARC:>= CL:>=) (ARC:> CL:>) ;>> (ARC:= CL:=) (ARC:<= CL:<=) (ARC:< CL:<) (ARC:++ CL:++) (ARC:+ CL:+)) ;>> ;=> <no values>

こんな感じに同名のシンボルを列挙してくれます。
check-duplicate-symbolsが表示ユーティリティで、リスト得たい場合には、duplicate-symbolsを使うという感じですね。

まとめ

 今回は、com.informatimago.tools.symbolを紹介してみました。パッケージ定義の時や、ライブラリのコードを読む前に確認したりする際に便利に使えそうですね。

CLISP: Weak Objectsの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の345日目です。

CLISP: Weak Objectsとはなにか

 CLISP: Weak Objectsは、CLISPの弱参照を扱う仕組みです。

パッケージ情報

パッケージ名CLISP: Weak Objects
ドキュメント31.7. Weak Objects

インストール方法

 CLISP標準の機能です。extパッケージで定義されています。

試してみる

 CLISP: Weak Objectsがサポートしている各種形式ですが、割合に充実しています。

  • Weak Pointers
  • Weak Lists
  • Weak “And” Relations
  • Weak “Or” Relations
  • Weak Associations
  • Weak “And” Mappings
  • Weak “Or” Mappings
  • Weak Association Lists
  • Weak Hash Tables

 最も基本になるのは、Weak Pointersですが、こんな感じにGC時に参照されていなければ消えます。

(defvar *wp*
  (ext:make-weak-pointer (list 1)))

(ext:weak-pointer-value *wp*) ;=> (1) ; T

(gc) ;=> 6540000 ; 1635000 ; 164808 ; 414 ; 460917632 ; 1032000

*wp* ;=> #<BROKEN WEAK-POINTER>

(ext:weak-pointer-value *wp*) ;=> NIL ; NIL

 この仕組みでリスト、alist、ハッシュテーブルの弱参照版が作られていますが、リストの場合は、weak pointerでリストを作るよりは効率が良いそうです。

(defvar *a* (list 'a))

(defvar *weak-list* (ext:make-weak-list (list *a* (list 'b) (list 'c))))

(ext:weak-list-list *weak-list*) ;=> ((A) (B) (C))

(gc) ;=> 6523344 ; 1630836 ; 164808 ; 403 ; 445232856 ; 920000

*weak-list* ;=> #<WEAK-LIST ((A))>

(ext:weak-list-list *weak-list*) ;=> ((A))

 Weak Relationsのorとandは、リスト内で参照されているものが一つでもあれば、全体が生きるのが、or、全部生きていなければ破棄されるのがandです。

(defvar *a* (list 'a))

(defvar *weak-and* (ext:make-weak-and-relation (list *a* (list 'b) (list 'c))))

*weak-and* ;=> #<WEAK-AND-RELATION ((A) (B) (C))>

(gc) ;=> 6521192 ; 1630298 ; 164808 ; 395 ; 432755648 ; 852000

*weak-and* ;=> #<BROKEN WEAK-AND-RELATION>

(defvar *weak-or* (ext:make-weak-or-relation (list *a* (list 'b) (list 'c)))) ;=> *WEAK-OR* *weak-or* ;=> #<WEAK-OR-RELATION ((A) (B) (C))>

(gc) ;=> 6521112 ; 1630278 ; 164808 ; 396 ; 434142344 ; 880000

*weak-or* ;=> #<WEAK-OR-RELATION ((A) (B) (C))>

 Weak Associationは、keyとvalueでkeyが生きていれば、組の値も参照できるというものです。

(defvar *key* (list 1))

(defvar *wa* (ext:make-weak-mapping *key* :value))

(ext:weak-mapping-value *wa*) ;=> :VALUE (setq *key* nil)

(gc) ;=> 6523888 ; 1630972 ; 164808 ; 429 ; 484286112 ; 1144000

*wa* ;=> #<BROKEN WEAK-MAPPING>

(ext:weak-mapping-value *wa*) ;=> NIL

仕組みの紹介としてはこんな感じですが、ユーティリティも充実していて使い勝手が良さそうです。ユーティリティの詳細はドキュメントと参照のこと。

まとめ

 今回は、CLISP: Weak Objectsを紹介してみました。
ざっと最近の処理系を見渡したところ弱参照のサポートの充実具合は実はCLISPが一番のようです。
CLISPは地味に充実しているところがあったりしますね。

let-by-needの紹介

Posted 2014-12-09 15:00:00 GMT

(LISP Library 365参加エントリ)
(Lisp Advent Calendar 2014参加エントリ)

 LISP Library 365 の344日目、Lisp Advent Calendar 2014の10日目です。

let-by-needとはなにか

 let-by-needは、Martin Abadi氏作のマクロによる式変形で遅延評価を実現するものです。

パッケージ情報

パッケージ名let-by-need
ソースコードLETBYN.LSP[COM,LSP]-www.SailDart.org

インストール方法

 上記ソースコードをダウンロードして適当に動かします。
MacLISP用のようですが、Common Lispでもstatusを定義してやればそのまま動きます(statusを削るのも可)

(defmacro status (thing &rest args)
  `(case ',thing
     (feature (member (car ',args) *features*))
     (otherwise nil)))

試してみる

 saildartのCommon Lispのディレクトリを眺めていて見付けたのですが、割合に面白そうなので紹介してみることにしました。1982年のコードなので32年前のコードですね。
どんなものかは動作をみるとわかりやすいのですが、

(let-by-need ((a (print 'a))
              (b (print nil))
              (c (print 'c)))
  (and a b c))
;>>  
;>>  A 
;>>  NIL 
;=>  NIL

こんな感じに遅延評価的にletの束縛部のcは使われていないので評価されないというものです。

 マクロの種類としては、構文の乗っ取り型でボディの中身を書き換えてしまいます。

(let-by-need ((a t)
              (b nil)
              (c t))
  (if (or a b)
      (and a c)
      (if a b c)))

;==> (LET ((A T)) (COND (A (AND A (LET ((C T)) C))) (T (LET ((B NIL)) (COND (B (AND A (LET ((C T)) C))) (T (AND T (COND (A B) (T (AND T (LET ((C T)) C)))))))))))

 let-by-needが把握できる式変形は、関数呼び出し、lambda式、if、cond、and、orです。

(let-by-need ((a (print 'a))
              (b (print nil))
              (c (print 'c)))
  (if a c b))
;>>  
;>>  A 
;>>  C 
;=>  C

;===>
(LET ((A (PRINT 'A)))
  (COND
   (A
    (LET ((C (PRINT 'C)))
      C))
   (T
    (AND T
         (LET ((B (PRINT NIL)))
           B)))))

(let-by-need ((a (print 'a))(b nil)(c (print 'c))) (lambda () a)) ;=> #<FUNCTION (LAMBDA ()) {1016F712AB}> ;===> (LAMBDA () (LET ((A (PRINT 'A))) A))

(let-by-need ((a (print 'a)) (b (print nil)) (c (print 'c))) (list a (list c))) ;>> ;>> A ;>> C ;=> (A (C)) ;===> (LET ((A (PRINT 'A)) (C (PRINT 'C))) (LIST A (LIST C)))

まとめ

 今回は、let-by-needを紹介してみました。
遅延評価のために元の式の方をマクロで書き換えてしまうというのはありそうでない方式ですね。
明日のLisp Advent Calendar 2014は、@y2q_actionmanさんです。お楽しみに。

foxの紹介

Posted 2014-12-08 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の343日目です。

foxとはなにか

 foxは、Joo ChurlSoo氏作の整形出力のユーティリティです。

パッケージ情報

パッケージ名fox
Chicken eggs:FOX - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install fox

すれば、

(use fox)

で使えます。

試してみる

 自分的には面白SRFIの人なJoo ChurlSoo氏ですが、foxは、srfi 54 catの改良型とのことです。

catは、引数の型によってオプションの意味が変わってくるという珍しい引数の取り方をしますが、foxでも同様です。
catではこの方式が難解だったということで、foxでは、分かりやすくしたということのようです。
ということで、catとfoxを並べてみると下記のような感じです。

(cat 129995 10 '(#\,) 'sign)
;=> "  +129,995"

(fox 129995 10 '#(",") '(sign)) ;=> " +129,995"

(cat 1234 10) ;=> " 1234"

(fox 1234 10) ;=> " 1234"

(cat 1234 -10) ;=> "1234 "

(fox 1234 -10) ;=> "1234 "

(cat 123456789 '(#\, 3) 15) ;=> " 123,456,789"

(fox 123456789 #("," 3) 15) ;=> " 123,456,789"

(cat 1234 10 'sign) ;=> " +1234"

(fox 1234 10 '(sign)) ;=> " +1234"

(cat "foo" 10 #\_ `(,string-upcase ,string-reverse)) ;=> "_______OOF"

(fox "foo" 10 #\_ `(,(compose string-upcase string-reverse) . 0)) ;=> "_______OOF"

(with-output-to-string (lambda () (cat "foo" out 10 #\. (list string-titlecase string-reverse)))) ;=> ".......ooF"

(with-output-to-string (lambda () (fox "foo" #t 10 #\. `(,(compose string-reverse string-titlecase) . 0)))) ;=> ".......ooF"

どの辺りが分かりやすくなったのかという気がしないでもありません…。

まとめ

 今回は、foxを紹介してみました。
引数の型に意味を持たせるというアイデアはあまり使われていないようなので、今後開拓の余地があるかもしれません。

sbcl: Iterator Protocolの紹介

Posted 2014-12-07 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の342日目です。

sbcl: Iterator Protocolとはなにか

 sbcl: Iterator Protocolは、sbclの拡張で、ユーザー定義のsequenceを扱える繰り返し規約です。

パッケージ情報

パッケージ名sbcl: Iterator Protocol
ドキュメントsbcl User Manual: Iterator Protocol

インストール方法

 sbclの標準機能で、sb-sequence(sequence)パッケージで定義されています。

試してみる

 341日目で紹介した、sbcl: Extensible Sequencesに近いところですが、ユーザー定義のsequenceを扱う繰り返し規約を定義できる仕組みです。
繰り返し規約というと、DylanのIteration Protocolを思い出しますが、Dylanのものにかなり影響を受けています。
Dylanでは、forward-iteration-protocolと、backward-iteration-protocolのメソッドがそれぞれ8つの値を返しますが、sbclの場合は、一つに統合されていて、方向を示す値が1つ追加されて9つの値の値を返します。

 では、適当にリストでも定義してみます。

(defclass kons (sequence standard-object)
  ((kar :accessor kar :initarg :kar)
   (kdr :accessor kdr :initarg :kdr))) 

(defun kons (x y) (make-instance 'kons :kar x :kdr y))

(defun lyst (&rest xs) (loop :for x :in (reverse xs) :for tail := (kons x nil) :then (kons x tail) :finally (return tail)))

(defmethod sequence:iterator-endp ((seq kons) iterator limit from-end) (eq iterator limit))

(defmethod sequence:iterator-step ((s kons) iterator from-end) (if from-end (if (eq iterator s) SB-IMPL::*EXHAUSTED* (do* ((xs s (kdr xs))) ((eq (kdr xs) iterator) xs))) (kdr iterator)))

(defmethod sequence:iterator-element ((s kons) iterator) (kar iterator))

(defmethod (setf sequence:iterator-element) (o (s kons) iterator) (setf (kar iterator) o))

(defmethod sequence:iterator-index ((s kons) iterator) ;; FIXME: this sucks. (In my defence, it is the equivalent of the ;; Apple implementation in Dylan...) (do ((tail s (kdr tail)) (i 0 (1+ i))) ((null tail)) (when (eq tail iterator) (return i))))

(defmethod sequence:iterator-copy ((s kons) iterator) iterator)

(defmethod sequence:length ((s kons)) (do ((tail s (kdr tail)) (i 0 (1+ i))) ((null tail) i)))

(defun nthkdr (n kons) (do ((tail kons (kdr tail)) (i 0 (1+ i))) ((or (null tail) (= n i)) tail)))

(defun kons-last (kons &optional (n 1)) (do ((tail kons (kdr tail))) ((null (nthkdr n tail)) tail)))

(defmethod sequence:make-simple-sequence-iterator ((s kons) &key from-end (start 0) end) (if from-end (let* ((termination (if (= start 0) sb-impl::*exhausted* (nthkdr (1- start) s))) (init (if (<= (or end (length s)) start) termination (if end (kons-last s (- (length s) (1- end))) (kons-last s))))) (values init termination t)) (cond ((not end) (values (nthkdr start s) nil nil)) (t (let ((st (nthkdr start s))) (values st (nthkdr (- end start) st) nil))))))

書いてみたというより殆どsbclのlistを扱う箇所のパクリですが、これで、sequence:dosequenceが使えるようになります。

(sequence:dosequence (e (lyst 0 1 2 3))
  (print e))
;>>  
;>>  0 
;>>  1 
;>>  2 
;>>  3 
;=>  NIL

 mapも内部ではdosequenceを利用しているので同じく扱えるように(新しいユーザー定義のsequenceを返すには別途定義が別途必要)

(map nil #'print (lyst 0 1 2 3))
;>>  
;>>  0 
;>>  1 
;>>  2 
;>>  3 
;=>  NIL

 更に、loopにもsequenceを扱うloop-pathが定義されているので、こんな感じに書けるようになります。

(loop :for e :being :the :elements :in (lyst 0 1 2 3)
      :collect e)
;=>  (0 1 2 3)

(loop :for e :being :each :element :of (lyst 0 1 2 3) :collect e) ;=> (0 1 2 3)

まとめ

 今回は、sbcl: Iterator Protocolを紹介してみました。
sequenceを扱うためのloop-pathはおまけ的に定義されている気もしますが、ひょっとするとこれが一番有用かもしれません。

sbcl: Extensible Sequencesの紹介

Posted 2014-12-06 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の341日目です。

sbcl: Extensible Sequencesとはなにか

 sbcl: Extensible Sequencesは、

パッケージ情報

パッケージ名sbcl: Extensible Sequences
ドキュメントsbcl User Manual: Extensible Sequences

インストール方法

 sbclの標準機能で、sb-sequence(sequence)パッケージで定義されています。

試してみる

 ANSI Common Lispでは色々あってユーザー定義のsequenceのサブクラスは一連のsequence関数では使えないのですが、ANSI準拠に篤いsbclにしては珍しく仕様を拡張してユーザー定義のsequenceを許すという拡張機能です。

 sb-sequence(sequence)で提供されているメソッド群ですが、ざっと

  • adjust-sequence
  • canonize-key
  • canonize-test
  • concatenate
  • copy-seq
  • count
  • count-if
  • count-if-not
  • delete
  • delete-duplicates
  • delete-if
  • delete-if-not
  • dosequence
  • elt
  • emptyp
  • fill
  • find
  • find-if
  • find-if-not
  • iterator-copy
  • iterator-element
  • iterator-endp
  • iterator-index
  • iterator-step
  • length
  • make-sequence-iterator
  • make-sequence-like
  • make-simple-sequence-iterator
  • map
  • merge
  • mismatch
  • nreverse
  • nsubstitute
  • nsubstitute-if
  • nsubstitute-if-not
  • position
  • position-if
  • position-if-not
  • reduce
  • remove
  • remove-duplicates
  • remove-if
  • remove-if-not
  • replace
  • reverse
  • search
  • sort
  • stable-sort
  • subseq
  • substitute
  • substitute-if
  • substitute-if-not
  • with-sequence-iterator
  • with-sequence-iterator-functions

という感じです。
Common Lisp標準のsequence関数と同名のものが多いですが、sequence:fooの方で拡張を作ると、cl:fooの方でもユーザー拡張のクラスが使えるようになります。

 この拡張案については、CDRでも提案されていますが、内容/経緯についてはこのCDRに詳しいです。

 では、試しに例として、適当にseriesと合体させてみます。

(defmethod sequence:emptyp ((seq foundation-series))
  (zerop (series:collect-length (series:subseries seq 0 1))))

(sequence:emptyp (series:scan '())) ;=> T

(defmethod sequence:make-sequence-like ((seq foundation-series) length &key initial-element initial-contents) (cond ((= length 0) (series:scan nil)) (initial-contents (series:scan initial-contents)) (t (series:mapping ((i (series:scan-range :from 0 :below length)) (e (series:series initial-element))) e))))

(coerce '(1 2 3 4 5) 'foundation-series) ;=> #Z(1 2 3 4 5)

(sequence:make-sequence-like (series:scan '()) 8 :initial-element 'z) ;=> #Z(Z Z Z Z Z Z Z Z)

(make-sequence 'foundation-series 4 :initial-element 42) ;=> #Z(42 42 42 42)

(defmethod sequence:adjust-sequence ((seq foundation-series) length &key initial-element (initial-contents nil ic-sp)) (cond ((= length 0) (series:scan nil)) (ic-sp (series:subseries (series:catenate seq (series:scan initial-contents)) 0 length)) (T (series:subseries (series:catenate seq (series:series initial-element)) 0 length))))

(sequence:adjust-sequence (series:scan-range :from 0 :upto 10) 15) ;=> #Z(0 1 2 3 4 5 6 7 8 9 10 NIL NIL NIL NIL)

(defmethod sequence:elt ((seq foundation-series) index) (series:collect-nth index seq))

(elt (series:scan-range :from 0 :upto 10) 9) ;=> 9

(defmethod sequence:subseq ((seq foundation-series) start &optional end) (if end (series:subseries seq start end) (series:subseries seq start)))

(subseq (series:scan-range :from 0 :upto 10) 5) ;=> #Z(5 6 7 8 9 10)

(defmethod sequence:length ((seq foundation-series)) (series:collect-length seq))

(length (series:scan-range :from 0 :upto 10)) ;=> 11

 という風に数点メソッドを書いてみましたが、それだけでも面白いです。
ちなみに思い付きで始めてしまいましたが、seriesは構造体で定義されているので、上記のように書くには構造体からクラスに変更する必要があり、さらにseriesのマクロの式変形黒魔術による最適化は一切考慮されていないので、使い物には全然ならないという例になりました…。

 ざっとQuicklispを眺めてみると、dlist、projectured、sequence-iteratorsあたりで使われているようですので、拡張を書いてみたい場合は、これらを参考にすると良いかなと思います。

まとめ

 今回は、sbcl: Extensible Sequencesを紹介してみました。
結構前から実装されていた機能なのですがドキュメント化されたのはここ1、2年だったと思います。
処理系依存ではありますが便利な機能ではあります。

climacsの紹介

Posted 2014-12-04 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の339日目です。

climacsとはなにか

 climacsは、Robert Strandh氏が中心となって開発されているCommon Lisp+CLIMで実装されたEmacs系エディタです。

パッケージ情報

パッケージ名climacs
Quicklisp
CLiKiCLiki: climacs
Quickdocsclimacs | Quickdocs
common-lisp.netClimacs - a Common Lisp Emacs implementation
CL Test Grid: ビルド状況climacs | CL Test Grid

インストール方法

(ql:quickload :climacs)

 quekさん作のmcclim-uimを使うとUIMで日本語入力が可能です。

mcclim-uimを利用する場合、mcclimの中のmcclim-freetypeも必要です。

(load "~/mcclim-uim/mcclim-uim.asd")
(load "~/quicklisp/dists/quicklisp/software/mcclim-20130813-cvs/Experimental/freetype/mcclim-freetype.asd")
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :mcclim)
  (ql:quickload :mcclim-freetype)
  (ql:quickload :mcclim-uim)
  ;; 以上の後でclimacsをロード
  (ql:quickload :climacs)
  )

試してみる

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

 Common Lispで拡張できる、もしくは、Common Lisp製のEmacsは良く話題になりますが、climacsはCommon Lispで拡張できるEmacs系エディタです。
といっても勿論Emacsの機能がなんでも使える訳ではなく、エディタの便利さは拡張言語がなんであるかとはまた別の話で、細かいところの出来や、拡張ライブラリの充実具合は、Emacsに近付くのはかなり大変であることが窺い知れます。
climacsは、Portable Hemlockと、McCLIMのGoateeエディタを統合するところから出発したようです。

 一応キーバインドをカスタマイズする方法でも書いてみますが、頑張ればCommon Lispの開発環境として使えないわけでもありません。
climacsを育てて行くのも一興かなと思います。

;; C-h をバックスペースにするために、C-h のキーストロークを削除。
(clim:remove-keystroke-from-command-table 'esa:help-table
                                          '(:keyboard #\h 512)
                                          :errorp nil)
;; C-h でバックスペース
(esa:set-key `(drei-commands::com-backward-delete-object
               ,clim:*numeric-argument-marker*
               ,clim:*numeric-argument-marker*)
             'drei:deletion-table
             '((#\h :control)))
;; C-m newline and indent
(esa:set-key 'drei-lisp-syntax::com-newline-indent-then-arglist
             'drei-lisp-syntax:lisp-table
             '((#\m :control)))
;; C-/ undo
(esa:set-key 'drei-commands::com-undo
             'drei:editing-table
             '((#\/ :control)))
;; C-i で補完
(esa:set-key 'drei-lisp-syntax::com-indent-line-and-complete-symbol
             'drei-lisp-syntax:lisp-table
             '((#\i :control)))
climacs

まとめ

 今回は、climacsを紹介してみました。
今ではあまり見掛けませんが、古くは大体の処理系にCommon Lisp製のEmacs系エディタが付属してきていました。
今でも商用処理系のAllegro CLやLispWorksにはCommon Lisp製のエディタは付属してきますが、さすがにEmacs程多機能ではないですね。

com.informatimago.common-lisp.interactiveの紹介

Posted 2014-12-03 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の338日目です。

com.informatimago.common-lisp.interactiveとはなにか

 com.informatimago.common-lisp.interactiveは、Pascal Bourguignon氏作の開発時に便利な対話的に使うユーティリティです。

パッケージ情報

パッケージ名com.informatimago.common-lisp.interactive
Quicklisp

インストール方法

(ql:quickload :com.informatimago.common-lisp.interactive)

試してみる

 定義されているものは、ざっとこんな感じなのですが、

  • *editor*
  • browse
  • cat
  • cd
  • compare-pathnames
  • date
  • define-package
  • diff-package
  • edit
  • less
  • list-all-symbols
  • list-external-symbols
  • ls
  • lschar
  • lspack
  • lssymbols
  • mkupack
  • more
  • mozilla-string
  • popd
  • popp
  • print-bug-report-info
  • print-pathname
  • pswitch
  • pushd
  • pushp
  • pwd
  • repl
  • reset-cluser
  • show
  • uptime

REPLからちょこっと実行してみたいものが多いようです。

UNIXコマンド系

 cat、cd、date、ls、less、more、popd、pushd、uptime、は、そのままUNIXのコマンド的なものです。

(date)
;>>  2014-11-19 18:01:22
;>>  
;=>  3625376482

(ls) ;>> foo.txt ;>> bar.txt ...

(cat "foo.txt") ;>> ............ ;>> ........

インスペクト系

 パッケージや、シンボル、オブジェクトの観察が短かいコマンドで実行可能です。

(lschar :start 32 :end 50)
;>>  #x00020      32     "Space"
;>>  #x00021      33  !  "EXCLAMATION_MARK"
;>>  #x00022      34  "  "QUOTATION_MARK"
;>>  #x00023      35  #  "NUMBER_SIGN"
;>>  #x00024      36  $  "DOLLAR_SIGN"
;>>  #x00025      37  %  "PERCENT_SIGN"
;>>  #x00026      38  &  "AMPERSAND"
;>>  #x00027      39  '  "APOSTROPHE"
;>>  #x00028      40  (  "LEFT_PARENTHESIS"
;>>  #x00029      41  )  "RIGHT_PARENTHESIS"
;>>  #x0002A      42  *  "ASTERISK"
;>>  #x0002B      43  +  "PLUS_SIGN"
;>>  #x0002C      44  ,  "COMMA"
;>>  #x0002D      45  -  "HYPHEN-MINUS"
;>>  #x0002E      46  .  "FULL_STOP"
;>>  #x0002F      47  /  "SOLIDUS"
;>>  #x00030      48  0  "DIGIT_ZERO"
;>>  #x00031      49  1  "DIGIT_ONE"
;>>  
;=>  (#\  #\! #\" #\# #\$ #\% #\& #\' #\( #\) #\* #\+ #\, #\- #\. #\/ #\0 #\1)

(lspack :sb-cltl2 :t) ;>> ;>> SB-CLTL2 ;>> Symbols: 9 exported, 2643 total. ;>> Uses: COMMON-LISP SB-C SB-INT SB-KERNEL ;>> Exported: AUGMENT-ENVIRONMENT COMPILER-LET ;>> DECLARATION-INFORMATION DEFINE-DECLARATION ENCLOSE ;>> FUNCTION-INFORMATION MACROEXPAND-ALL PARSE-MACRO ;>> VARIABLE-INFORMATION ;>> ;=> NIL

(diff-package :ibcl :cl) ;>> ;>> ;>> Symbols exported from IBCL not exported from CL: ;>> IBCL:WITH-PACKAGE-ITERATOR ;>> IBCL:USE-PACKAGE ;>> IBCL:UNUSE-PACKAGE ;>> IBCL:UNEXPORT ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.SOURCE:SYMBOLS-WITH-SOURCES ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.SOURCE:SOURCE ;>> IBCL:SHADOWING-IMPORT ;>> IBCL:SHADOW ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.SOURCE:SAVE-SOURCES ;>> IBCL:MAKE-PACKAGE ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.SOURCE:LIST-SOURCES ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.SOURCE:LIST-PACKAGES-WITH-SOURCES ;>> IBCL:IN-PACKAGE ;>> IBCL:IMPORT ;>> IBCL:FIND-SYMBOL ;>> IBCL:FIND-PACKAGE ;>> IBCL:DO-SYMBOLS ;>> IBCL:DO-EXTERNAL-SYMBOLS ;>> IBCL:DELETE-PACKAGE ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFVAR ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFUN ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFTYPE ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFSTRUCT ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFSETF ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFPARAMETER ;>> IBCL:DEFPACKAGE ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFMETHOD ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFMACRO ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFINE-SYMBOL-MACRO ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFINE-SETF-EXPANDER ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFINE-MODIFY-MACRO ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFINE-METHOD-COMBINATION ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFINE-CONDITION ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFINE-COMPILER-MACRO ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFGENERIC ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFCONSTANT ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES:DEFCLASS ;>> COM.INFORMATIMAGO.COMMON-LISP.LISP.SOURCE:*SOURCE-TYPES* ;>> ;>> ;=> NIL

その他便利系ユーティリティ

 ファイルブラウザのbrowse、パッケージを定義するdefine-package、:com.informatimago.common-lisp.interactive.interactiveが使えるパッケージを作ってくれるmkupack、シンプルなrepl等、replをシェル代わりする場合には結構使えそうなツールが揃っています。

まとめ

 今回は、com.informatimago.common-lisp.interactiveを紹介してみました。処理系のREPLには、こういう便利コマンドが組込まれていたりしますが、com.informatimago.common-lisp.interactiveは、一歩踏み込んでいて便利そうです。

alternativesの紹介

Posted 2014-12-02 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の337日目です。

alternativesとはなにか

 alternativesは、Patrick Stein氏作のコードの開発用のユーティリティです。

パッケージ情報

パッケージ名alternatives
Quicklisp
プロジェクトページnklein/alternatives · GitHub
参考ドキュメントCode That Tells You Why :: nklein software

インストール方法

 現在のところQuicklispには収録されていないのでリポジトリから取得してQuicklispのlocal-projectsに置けば、

(ql:quickload :alternatives)

でロード可能です。

試してみる

 使い方と仕組みは単純で、alternativesというマクロは、最後の節だけコードが活きるという単純なマクロです。

(defun fib (n)
  (alternatives
    (slow
     (if (< n 2)
         n
         (+ (fib (1- n))
            (fib (- n 2)))))
    (fast
     (labels ((fib (n a1 a2)
                (cond ((zerop n) a2)
                      ((= 1 n) a1)
                      (T (fib (1- n) (+ a1 a2) a1)))))
       (fib n 1 0)))))
;===>
(DEFUN FIB (N)
  (PROGN
   (LABELS ((FIB (N A1 A2)
              (IF (ZEROP N)
                  (PROGN A2)
                  (IF (= 1 N)
                      (PROGN A1)
                      (THE T (PROGN (FIB (1- N) (+ A1 A2) A1)))))))
     (FIB N 1 0))))

のように展開されますが、***という印を付けると最後以外の節が有効になります。
節の名前が、finalもしくはblessedの場合も同様。

(defun fib (n)
  (alternatives
    ***
    (slow
     (if (< n 2)
         n
         (+ (fib (1- n))
            (fib (- n 2)))))
    (fast
     (labels ((fib (n a1 a2)
                (cond ((zerop n) a2)
                      ((= 1 n) a1)
                      (T (fib (1- n) (+ a1 a2) a1)))))
       (fib n 1 0)))))
;===>
(DEFUN FIB (N)
  (PROGN
   (IF (< N 2)
       N
       (+ (FIB (1- N)) (FIB (- N 2))))))

 これが、どんな風に使われることを意図しているかというと、

(defun sum-i^2 (n)
  (alternatives
    (i-wanted-to-do-this
     (loop :for i :to n :summing (* i i)))

(my-first-attempt-was-something-like-this (do ((i 0 (1+ i)) (sum 0 (+ sum (* i i)))) ((> i n) sum)))

(but-i-could-not-do-that-because "Some people find a do-loop to hard to read (and 'too' too hard to spell, apparently).")

(now-i-know-better-and-can-do-this (/ (* n (1+ n) (1+ (+ n n)) 6)))))

 こんな風に開発時の試行錯誤を残しておくのに使います。
単なるコメントと違って代替コードが実行できるというのが味噌でしょうか。

まとめ

 今回は、alternativesを紹介してみました。
ブログでのライブラリ解説のエントリーのコメント欄でも賛否両論ではありますが、コードを後から読む場合には助けになりそうです。
代替コードからテスト用の検証コードを生成する機能があっても良さそう。

com.informatimago.common-lisp.lisp-sexpの紹介

Posted 2014-12-01 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の336日目です。

com.informatimago.common-lisp.lisp-sexpとはなにか

 com.informatimago.common-lisp.lisp-sexpは、Pascal Bourguignon氏作のCommon Lispの構文を操作するユーティリティです。

パッケージ情報

パッケージ名com.informatimago.common-lisp.lisp-sexp
Quicklisp

インストール方法

(ql:quickload :com.informatimago.common-lisp.lisp-sexp)

試してみる

 定義構文のマクロは構文要素に分解するのが面倒だったりするのですが、com.informatimago.common-lisp.lisp-sexpを利用すれば、lambda-listや定義ボディ部の宣言やドキュメンテーション文字列を簡単に扱えます。
主な関数は、parse-bodyと、parse-lambda-listです。

parse-body

 parse-bodyは、ボディ部の式を取ってドキュメンテーション文字列、宣言、残り本体、の3つの値を返します。

(defparameter *form*
  '(defun foo (n)
    "foo(n): return: n + 42"
    (declare (fixnum n))
    (+ 42 n)))

(parse-body :lambda (cdddr *form*)) ;=> ("foo(n): return: n + 42") ; ((DECLARE (FIXNUM N))) ; ((+ 42 N))

ボディのタイプとしては、:lambda、:locally、:prognがあります。

parse-lambda-list

 parse-lambda-listの方は、:ordinary :boa :specialized :modify-macro :generic :macro :type :destructuring :setf :method-combinationのタイプをサポート

(defmacro defun-form (name (&rest args) &body body)
  (let ((args (parse-lambda-list args :macro)))
    (multiple-value-bind (doc dcls body) (parse-body :lambda body)
      `'(:name ,name
         :lambda-list ,(make-lambda-list args)
         :doc ,@doc
         :decls ,@dcls
         :body ,@body))))

(defun-form foo (n o p &environment env) "foo" (declare (ignore n)) (declare (ignore o)) (declare (ignore p)) :foo :bar :baz) ;=> (:NAME FOO :LAMBDA-LIST (&ENVIRONMENT ENV N O P) :DOC "foo" :DECLS ; (DECLARE (IGNORE P)) (DECLARE (IGNORE O)) (DECLARE (IGNORE N)) :BODY :FOO :BAR ; :BAZ)

まとめ

 今回は、com.informatimago.common-lisp.lisp-sexpを紹介してみました。lambda-listや、宣言のパーズは、割合に面倒なので、こういうユーティリティは便利です。

YTools: Facilities for Setting and Matchingの紹介

Posted 2014-11-30 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の335日目です。

YTools: Facilities for Setting and Matchingとはなにか

 YTools: Facilities for Setting and Matchingは、Drew McDermott氏のユーティリティであるYtoolsの中の代入とパタンマッチのユーティリティです。

パッケージ情報

パッケージ名YTools: Facilities for Setting and Matching
Quicklisp×
プロジェクトページHome page for Drew McDermott
CLiKiCLiki: YTools

インストール方法

 上記プロジェクトページからダウンロードしてきて適当に導入します。

試してみる

 代入とパタンマッチの構文ですがsetterに含まれています。

!=

 !=は、setfの拡張版とのことなので、拡張されたところを紹介してみますが、まず多値を受ける構文があります、

(let (x y)
  (!= < x _ y > (values 1 2 3))
  (list x y))
;=>  (1 3)

<と>で囲みますが、_で無視することもできます。
似たような構文ですが、括弧が付くと、リストの部分にマッチさせられます。

(let ((u (*:iota 10))
      x y z)
  (!= (< _ _ _ _ _ x y z >) u)
  (list x y z))
;=>  (5 6 7)

(let ((u (*:iota 10)) x y z) (!= (< _ _ _ _ _ x y z >) u) (list x y z))

さらに、アナフォリックマクロ的な動作も可能で、*-*という変数が読み出して来た値になるので、こんな事も可能です。

(let ((u (*:iota 10)))
  (!= (elt u 8) (list *-*))
  u)
;=>  (0 1 2 3 4 5 6 7 (8) 9)

Common Lispだと

(let ((u (*:iota 10)))
  (setf (elt u 8) (list (elt u 8)))
  u)

と書かなくてはいけないので便利といえば便利ですね。ちなみにTAOだと

(let ((u (*:iota 10)))
  (!!list !(elt u 8))
  u)
;=>  (0 1 2 3 4 5 6 7 (8) 9)

と書けたりします。

matchq、match-cond、match-let

 次にパタンマッチですが、基本構文としてmatchqがあり、他はこれの上に構築されています。
最後のqは、setqから来ているようですが、matchqはマッチ状況を真偽値で返す代入構文で、全体のマッチは失敗しても成功した部分は代入されたりします。

(let ((u '(1 2 3))
      x)
  (matchq (?x 2 3) u)
  x)
;=>  1

(let ((u '(1 2 3 4 5 nil)) x y z) (matchq (?x ?@y ?z) u) (list x y z)) ;=> (1 (2 3 4 5) 6)

?や@はリーダーマクロですが、パタン変数を表しています。
パタンマッチということでいつものharropifyを書いてみます。
ガード等の記法がやや独特ですが、記述できることは色々あります(詳細はマニュアル参照のこと)

(defun harropify (x)
  (match-cond x
    (:? (?Op ?A ?B)
        (h Op (harropify A) (harropify B)))
    (T x)))

(defun h (op a b) (match-cond (list op a b) (:? (+ ?(:+ ?M numberp) ?(:+ ?N numberp)) (+ M N)) (:? (+ 0 ?F) F) (:? (+ ?F 0) F) (:? (+ ?M (+ ?N ?O)) (h '+ (h '+ M N) O)) (:? (* ?(:+ ?M numberp) ?(:+ ?N numberp)) (* M N)) (:? (* 0 ?_) 0) (:? (* ?_ 0) 0) (:? (* ?F 1) F) (:? (* 1 ?F) F) (:? (* ?M (* ?N ?O)) (h '* (h '* M N) O)) (T (list Op A B))))

(harropify '(* x (+ (+ (* 12 0) (+ 23 8)) y))) ;=> (* X (+ 31 Y))

(dotimes (i (expt 10 7)) (harropify '(* x (+ (+ (* 12 0) (+ 23 8)) y)))) ;=> NIL #|------------------------------------------------------------| Evaluation took: 1.291 seconds of real time 1.300000 seconds of total run time (1.300000 user, 0.000000 system) 100.70% CPU 4,249,425,870 processor cycles 3,359,990,288 bytes consed

Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz |------------------------------------------------------------|#

こんな感じですが、optimaが1.130secだったので結構速い方だと思います。

 この他、定番のmatch-letもあります。

(match-let (?x ?y (?(:+ ?z numberp))) '(1 2 (3))
  (list x y z))
;=>  (1 2 3)

まとめ

 今回は、YTools: Facilities for Setting and Matchingを紹介してみました。
結構独自色の強い部分でしたが馴れれば便利なこともありそうです。

com.informatimago.common-lisp.lisp-textの紹介

Posted 2014-11-29 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の334日目です。

com.informatimago.common-lisp.lisp-textとはなにか

 com.informatimago.common-lisp.lisp-textは、Pascal Bourguignon氏作のCommon Lispのソースコードを操作するためのライブラリです。

パッケージ情報

パッケージ名com.informatimago.common-lisp.lisp-text
Quicklisp

インストール方法

(ql:quickload :com.informatimago.common-lisp.lisp-text)

試してみる

 主な関数は、source-readで、ファイルから読み込んだ定義をソースオブジェクトとして返します。
定義や、コメント、オブジェクト等はそれぞれ別のクラスになって格納されるので、編集操作が簡単に可能です。

 試しにあるシステムから最長のdefunを抜き出すという関数を作ってみます。

(defpackage :source-text-demo
  (:use :cl)
  (:import-from :com.informatimago.common-lisp.lisp-text.source-text
                :source-read
                :source-object-text))

(cl:in-package :source-text-demo)

(defun system-sources (system) (loop :for file :in (mapcar #'asdf:component-pathname (asdf:component-children (asdf:find-system system))) :append (with-open-file (in file) (loop :for item := (source-read in nil in) :until (eq item in) :collect item))))

(defun find-the-longest-defun-form (src) (flet ((count-lines (text) (count #\Newline text))) (let* ((items (copy-list src)) (text (source-object-text (first (sort (remove-if-not (lambda (x) (and (source-object-text x) (*:scan "^\\(defun" (source-object-text x)))) items) #'> :key (lambda (x) (count-lines (source-object-text x)))))))) (format T "~&;;;~%;;; ~D line~:*~P~%;;;~%~A" (count-lines text) text))))

実行

(find-the-longest-defun-form (system-sources :contextl))
;>>  ;;;
;>>  ;;; 34 lines
;>>  ;;;
;>>  (defun ensure-layered-function
;>>         (name
;>>          &rest initargs
;>>          &key (lambda-list () lambda-list-p)
;>>          (argument-precedence-order (required-args lambda-list))
;>>          (documentation nil)
;>>          (generic-function-class 'layered-function)
;>>          &allow-other-keys)
;>>    (unless lambda-list-p
;>>      (error "The layered function ~S must be initialized with a lambda list." name))
;>>    (let ((gf (let ((layer-arg (gensym "LAYER-ARG-")))
;>>                (apply #'ensure-generic-function
;>>                       (lf-definer-name name)
;>>  		     :generic-function-class
;>>                       generic-function-class
;>>                       :argument-precedence-order
;>>                       `(,@argument-precedence-order ,layer-arg)
;>>                       :lambda-list
;>>                       `(,layer-arg ,@lambda-list)
;>>                       (loop for (key value) on initargs by #'cddr
;>>                             unless (eq key :documentation)
;>>                             nconc (list key value))))))
;>>      (setf (fdefinition name)
;>>            (let ((lambda `(lambda (&rest rest)
;>>                             (declare (optimize (speed 3) (debug 0) (safety 0)
;>>                                                (compilation-speed 0)))
;>>                             (apply (the function ,gf)
;>>                                    (layer-context-prototype *active-context*)
;>>                                    rest))))
;>>              #-ecl (compile nil lambda)
;>>              #+ecl (coerce lambda 'function)))
;>>      (when documentation
;>>        (setf (documentation name 'function) documentation))
;>>      (bind-lf-names name)
;>>      gf))
;=>  NIL

まとめ

 今回は、com.informatimago.common-lisp.lisp-textを紹介してみました。コメントを削除したり、定義間の行間を変更したりも簡単にできますし、応用次第では結構色々できそうです。

common-idiomsの紹介

Posted 2014-11-27 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の332日目です。

common-idiomsとはなにか

 common-idiomsは、Brian Mastenbrook氏作のCommon Lispのユーティリティ集です。

パッケージ情報

パッケージ名common-idioms
Quicklisp×
CLiKiCLiki: common-idioms

インストール方法

 CLiKiのリンクも死んでいますが、archive.orgでファイルを探すか、common-idioms-3.tar.gzでググって適当にソースを探します。ASDFで読み込めるので、Quicklispのlocal-projectsに置けばQuicklispでロード可能です。

  • ftp://tux.rainside.sk/gentoo/distfiles/common-idioms-3.tar.gz
(ql:quickload :common-idioms)

試してみる

 定義されているユーティリティは下記の通りです。

  • aif
  • aif2
  • destructuring-case
  • expand-only
  • fconstantly
  • it
  • let-env
  • let-env*
  • macroexpand-n
  • macrolet*
  • map1
  • reducen
  • run-tests
  • setf-it
  • sif
  • symbolic
  • with-gensyms

 適当につらつらと紹介していきたいと思いますが、else節でsetf-itというのが使えるのが面白いaif

(let ((xs (list nil 2)))
  (aif2 (car xs)
      it
      (setf-it 42))
  xs)
;=>  (42 2)

(let ((tab (*:alist-hash-table '((a . 0) (b . 1))))) (aif2 (gethash 'c tab) it (setf-it 42)) (*:hash-table-alist tab)) ;=> ((C . 42) (B . 1) (A . 0))

ここまで複雑だとパタンマッチマクロの方が使いやすそうなdestructuring-case

(destructuring-case next (1)
  (((1 (y (z))) (list 1 y z))
   ((x (y (z))) (list z y x)))
  '(1 (2 (3)))
  :else)
;=>  (1 2 3)

(destructuring-case next (1) (((1 (y (z))) (list 1 y z)) ((x (y (z))) (list x y z))) '(1 (2 (3 8))) :else) ;=> :ELSE

展開するフォームを指定できるexpand-only

(expand-only '()
             '(defun foo (n)
               (when n
                 (list n))))
;=>  (DEFUN FOO (N) (WHEN N (LIST N)))
;    NIL

(expand-only '(when) '(defun foo (n) (when n (list n)))) ;=> (DEFUN FOO (N) ; (IF N ; (PROGN (LIST N)) ; NIL)) ; NIL

多分マクロの中でgensymのリストを作るのに使うfconstantly

(mapcar (fconstantly #'gensym) '(a b c))
;=>  (#:G1915 #:G1916 #:G1917)

レキシカルスコープを曲げるlet-env/let-env*

(let ((x 3))
  (let-env e0
    (let ((x 4))
      (e0 (x) (list x)))))
;=>  (3)

(let ((x 3) (y 4)) (let-env* e0 (x y) (let ((x 4)) x (e0 (list x y))))) ;=> (3 4)

let-env*とmacroletを合体して、let-env*の環境を持ち運ぶマクロに任意の名前を付けられるようにしたmacrolet*

(let ((x 3))
  (macrolet* (x) ((foo (x) x))
    (let ((x 2))
      (foo x))))
;=>  3

ところで、bend-lexicalという表現の大元は、The Scheme Programming Language, 2nd Edition(Kent Dybvig)なんでしょうか。

その他、多値関数でreduceするreducen、指定した回数展開するmacroexpand-n等があります。

まとめ

 今回は、common-idiomsを紹介してみました。
十年前は大活躍していたBrian Mastenbrook氏ですが、この5、6年位はLisp的な活動はしていないようです。
色々活躍していただけに残念ですね。

com.informatimago.common-lisp.lisp.stepperの紹介

Posted 2014-11-26 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の331日目です。

com.informatimago.common-lisp.lisp.stepperとはなにか

 com.informatimago.common-lisp.lisp.stepperは、Pascal Bourguignon氏作のポータブルなステップ実行のユーティリティです。

パッケージ情報

パッケージ名com.informatimago.common-lisp.lisp.stepper
Quicklisp

インストール方法

(ql:quickload :com.informatimago.common-lisp.lisp.stepper)

試してみる

Common Lispの標準にもstepというステップ実行の為のユーティリティは存在するのですが、SBCLやCCLのようにコンパイル指向の場合は、実行時にソースがないのでstepを実行しても素気ない感じで終わります。
(defun fib (n)
  (if (< n 2)
      n
      (+ (fib (1- n))
         (fib (- n 2)))))

(step (fib 1))

Evaluating call: (FIB 1) With arguments: 1 [Condition of type SB-EXT:STEP-FORM-CONDITION]

Restarts: 0: [STEP-CONTINUE] Resume normal execution 1: [STEP-OUT] Resume stepping after returning from this function 2: [STEP-NEXT] Step over call 3: [STEP-INTO] Step into call 4: [RETRY] Retry SLIME interactive evaluation request. 5: [*ABORT] Return to SLIME's top level. --more--

;⌨ -> 0 ;=> 1

 com.informatimago.common-lisp.lisp.stepperを使えば、コンパイル指向の処理系でもソースを追い掛けた感じのステップ実行が可能です。
可能ですが、ただし専用のパッケージ内で関数を定義する必要があります。

(defpackage :stepper-demo
  (:use :stepper))

(cl:in-package :stepper-demo)

(defun fib (n) (if (< n 2) n (+ (fib (1- n)) (fib (- n 2)))))

という定義をして、stepを実行

(stepper:step (fib 1))

(Will evaluate (fib 1) Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)? ;⌨ -> RET Will evaluate (fib 1) (Will evaluate 1 Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)? ;⌨ -> RET (--> 1)) (Entering function fib (Bind n to 1) Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)? ;⌨ -> RET (Will evaluate (if (< n 2) n (+ (fib #) (fib #))) Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)? ;⌨ -> RET Will evaluate (if (< n 2) n (+ (fib #) (fib #))) (Will evaluate (< n 2) Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)? ;⌨ -> RET Will evaluate (< n 2) (Will evaluate n Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)? ;⌨ -> RET (n ==> 1)) (Will evaluate 2 Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)? ;⌨ -> RET (--> 2)) Evaluation of (< n 2) returned one result ==> T) (Will evaluate n Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)? ;⌨ -> RET (n ==> 1)) Evaluation of (if (< n 2) n (+ (fib #) (fib #))) returned one result ==> 1) Exiting function fib returned one result ==> 1) Evaluation of (fib 1) returned one result ==> 1)

 ちょっとみづらい気がするので改造してみますが、

(defun stepper::will-step (form &optional (stream *step-trace-output*))
  (with-step-printing
    (let ((pos (sb-kernel:charpos stream)))
      (format stream
              "Will evaluate ~&~VT⎛~&~VT⎜  ~S~&~VT⎝~%"
              pos
              pos
              form
              pos))))
(Will evaluate 
 ⎛
 ⎜  (fib 1)
 ⎝
 Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)?
;⌨ -> RET
Will evaluate 
 ⎛
 ⎜  (fib 1)(Will evaluate 
  ⎛
  ⎜  1
  ⎝
  Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)?
;⌨ -> RET
  (--> 1))
 (Entering function fib
   (Bind n                to 1)
  Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)?
;⌨ -> RET
  (Will evaluate 
   ⎛
   ⎜  (if (< n 2) n (+ (fib #) (fib #)))
   ⎝
   Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)?
;⌨ -> RET
Will evaluate 
 ⎛
 ⎜  (if (< n 2) n (+ (fib #) (fib #)))(Will evaluate 
    ⎛
    ⎜  (< n 2)
    ⎝
    Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)?
;⌨ -> RET
Will evaluate 
 ⎛
 ⎜  (< n 2)(Will evaluate 
     ⎛
     ⎜  n
     ⎝
     Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)?
;⌨ -> RET
     (n ==> 1))
    (Will evaluate 
     ⎛
     ⎜  2
     ⎝
     Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)?
;⌨ -> RET
     (--> 2))
    Evaluation of (< n 2) returned one result ==> T)
   (Will evaluate 
    ⎛
    ⎜  n
    ⎝
    Step Into (s, si, RET), Step over (so), Trace (t), Function (f), Run (r), List (l), Eval (e), Debugger (d), Abort (a, q)?
;⌨ -> RET
    (n ==> 1))
   Evaluation of (if (< n 2) n (+ (fib #) (fib #))) returned one result ==> 1)
  Exiting  function fib returned one result ==> 1)
 Evaluation of (fib 1) returned one result ==> 1)

という風に評価される部分で一歩ずつ止まります。

 専用のパッケージで定義する必要があるということから大体想像が付きますが、com.informatimago.common-lisp.lisp.stepperではソースを保存するために必要となる関数にステップ実行の為の仕掛けを入れます。

(defun fib (n)
  (if (< n 2)
      n
      (+ (fib (1- n))
         (fib (- n 2)))))

;==> (stepper:defun fib (n) (stepper:if (cl:< n 2) n (cl:+ (fib (cl:1- n)) (fib (cl:- n 2)))))

まとめ

 今回は、com.informatimago.common-lisp.lisp.stepperを紹介してみました。ステップ実行が苦手な処理系を使っていると、stepも使わなくなりますが、これならデバッグ時に利用できるかもしれないですね。

MIT FORMATの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の330日目です。

MIT FORMATとはなにか

 MIT FORMATは、MIT系Lispでお馴染のFORMATです。

パッケージ情報

パッケージ名MIT FORMAT

インストール方法

 LispマシンのソースやMacLISPのソースからひっこ抜いてきて動かします。
Lispマシン版は、LMI LambdaのものをCommon Lispに移植してみたものがありますので興味があったらどうぞ。

試してみる

 MIT系Lispの機能で魔窟と化しているものの代表例として、FORMATとLOOPがあります。これら以外だとDEFSTRUCTとラムダリストもそうでしょうか。
拡張を繰り返して謎の機能を盛り込み、最終的にはユーザーが拡張できるようになることが多いようなのですが、Common Lispが出た頃には既に収束していたようです。
大別するとMacLISPのFORMATとLispマシンのFORMATがあるのですが、どちらも機能的には大体同じです。
MacLISP版の方は、MacLISP/NIL/Zetalispのスーパーセットのような方言でかつ、文芸的プログラミングのようにも書けて、コードからドキュメントも生成されるというLSBというフォーマットで書かれています(MIT/LCS/TM-200参照のこと)

 Common LispのFORMATと大体のところは同じですが、DEFFORMATでユーザーが拡張できます。
一文字の場合は、~文字 で呼び出せて、複数文字の場合は、~\名前~\ で呼び出せます。
Common Lispでも~//でユーザー定義の関数を利用可能なので、Common Lispでできないことといえば、一文字の指示子が定義できる位でしょうか(MacLISP/Zetalispではエスケープが\なので/と入れ替わっています。)

 defformatで漢数字を表示する指示子を作ってみると、

(knum (random (expt 10 63)))
;=>  "三百七十一那由他四千九百五十一阿僧祇二千七百九十八恒河沙三千九百七十六極九千三十九載四千三百七正二千七百六十九澗八千八百八十一溝六千九十一穣八千五百六十七𥝱八千五百九十五垓四千二百四十一京千八百九十九兆四千九百八億千六万四千九百十一"
;; のようなものが予め定義されているとする

(defun knum-format (arg params)
  (declare (ignore params))
  (princ (knum arg) *standard-output*))

(lambda.format:defformat(:one-arg) knum-format)

(lambda.format:format t "~D = ~:*~数" (random (expt 10 63)))
;>>  729257794194361409722610781525163841524812490803370431050961803 = 七百二十九那由他二千五百七十七阿僧祇九千四百十九恒河沙四千三百六十一極四千九十七載二千二百六十一正七百八十一澗五千二百五十一溝六千三百八十四穣千五百二十四𥝱八千百二十四垓九千八十京三千三百七十兆四千三百十億五千九十六万千八百三
;=>  NIL

のような感じでしょうか。上記では、ユーザーが登録できると説明しましたが、*FORMAT-CHAR-TABLE*に指示子の文字を登録しないといけないので、一文字の指示子は、あまりユーザーが気軽に定義するものでもないのかもしれません。
defformatでは、~{ ~}のような繰り返し構文も定義できるので、これを定義しだすとかなり奥が深いかもしれません。

 defformatによってCommon Lispにはないプリセットがいくつかあるので紹介してみます。

(lambda.format:format t "~\\time-interval\\" 100000)
;>>  1 day 3 hours 46 minutes 40 seconds
;=>  NIL

(lambda.format:format t "~\\datime\\") ;>> 12-Nov-14 22:04:55 ;=> NIL

(lambda.format:format t "~\\time\\" (get-universal-time)) ;>> 12-Nov-14 22:04:30 ;=> NIL

(lambda.format:format t "~\\date\\" (get-universal-time)) ;>> Wednesday the twelfth of November, 2014; 10:02:07 pm ;=> NIL

(lambda.format:print-list t "~2,'0D" '(1 2 3 4)) ;>> 01, 02, 03, 04 ;=> NIL

(lambda.format:format t "~\\scientific\\" (* 1.2 (expt 10.0 -18))) ;>> 1.20 atto ;=> NIL

(lambda.format:format t "~\\scientific\\" (* 1.2 (expt 10.0 12))) ;>> 1.20 tera ;=> NIL

(lambda.format:format t "~\\scientific\\" (* 1.2 (expt 10.0 18))) ;>> 1.20*10^18 ;=> NIL

等、主に時刻表示系の拡張が多いようです。~\scientific\は、あると便利かもしれません。

~Rの頑張り具合

 MIT系FORMATには色々な実装がありますが、~Rの表示についても色々です、Lispマシン版だと、

(format t 
        "~R"
        53999500948468952310038099781463571339047070077306365693157950031578865323656556470575617800343597469266163663053930729475284065797602507890543303778576751659589305608587610531708947533895013315667863040414361345468355481863098933946821494355280950711022187712940833316965953579893344816889296853809961893920288590813027274832826286947619604118250774207139185726707912013800939692113888334217321860037292466401359841909988633619607424903033450804126082814732707445124637525158238170968502713843469571111703598881772316107519263725449255479619898953254897560246329021003281382925172651714439764626563531074131156571665535676768755978740766873401181144256032811285441096311372679045330018428567938178094868712065068580809639275865131706462924775859365765458767892117014063125832876850531909154025650741916731357605935258947617751694792571197098071783553594056528313033244684266522404884784128003483709377045135811006490113848405279358750014669073521011548847837131136223674359357217325635332834429988293603397900589509479837107016653173146909465177952625778626216629083679921666803483394754450376941974550174091383204437716802171570061760417244518512843899701602964043259316720291129674329623222095297987389862598611240772884052719518970002304729523579043924577088361947008622544898239153515583379016768983297954121631081900889082400864067922600058400594238765010038489366358777002458031646082067722222514413839769452342632052290914556513716288379792729240853178303687025708955633480327380407923497850078420951985228579182612827147156878135218016259208631905768836986349361622245047674221778752695741210062306761661214307852665308621602864895728252916695112242072057480560958982341308100038716195984028347126604774936339276344081453742527548489965530976385763555878830918393648006130327327960704190904833212123903052891668786081836403824776774739850875709244292639039286939523104981546952953715780347934873229269429413881121903483764180865612725119566557443754191618555762081666047374746885983734614362337775745740375778738449658551507347449245742571619102174718114780803496920602156991309405209306051844513234344718816003897543309309554346752817036736575996706489202820650462415829202264497295289415112871468983090812832130317305226698442428490067416807537978549413114929045397194539604652830651471796026129295170532822597153883218867600018669161448985415894865487458662894655907371802544792611911196859473623714636886396579347590382034792368841023838815244989979251077104385311030453119874016830081042555655934964624991309367125628395577317651104735842449752179982674841263897030388895518361919869316899138079512261304365737790278071798129962236923346021371069026119976758928476946207645148585533271169588887008698168228540845488993201135317041879520393746627802502286733993852679366573642477866184470002897130179074050812975982271794837828584984428523206394416339396120267888799143183191074876414412012246672245565330593788479217065837148544042485924208932461014686265859689846010276942771331837221759)

は、

fifty-three times ten to the three thousandth power plus nine hundred ninety-nine times ten to the two thousand nine hundred ninety-seventh power plus five hundred times ten to the two thousand nine hundred ninety-fourth power plus
....
eight hundred thirty-seven million two hundred twenty-one thousand seven hundred fifty-nine

のように表示されるため、上限は特にないようです。
ちなみに、~Rで随分と頑張っているのは、CMUCLのFORMATで、上記の例だと、

fifty-three novenonagintanongentillion nine hundred ninety-nine octononagintanongentillion five hundred septenonagintanongentillion nine hundred forty-eight senonagintanongentillion four hundred sixty-eight quinquanonagintanongentillion nine hundred fifty-two quattuornonagintanongentillion three hundred ten trenonagintanongentillion thirty-eight duononagintanongentillion ninety-nine unnonagintanongentillion seven hundred eighty-one nonagintanongentillion four hundred sixty-three novemoctogintanongentillion five hundred seventy-one octooctogintanongentillion three hundred thirty-nine septemoctogintanongentillion forty-seven sexoctogintanongentillion seventy quinquaoctogintanongentillion seventy-seven quattuoroctogintanongentillion three hundred six tresoctogintanongentillion three hundred sixty-five duooctogi
....
thirty-one billion eight hundred thirty-seven million two hundred twenty-one thousand seven hundred fifty-nine

と表示されます。10の3002乗のone hundred novenonagintanongentillionまでサポートしている様子。10の3003乗からはエラーになります。

まとめ

 今回は、MIT FORMATを紹介してみました。
これが1980年前後のMITの魔拡張機能だ!と思って紹介するつもりでしたが、FORMATは割とCommon Lisp版にも機能が取り込まれていました。
Common Lispのformatの~//で便利に使える関数は、それほど流通していないようなので便利な物が流通すると良いですね。

com.informatimago.common-lisp.lisp.ibclの紹介

Posted 2014-11-24 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の329日目です。

com.informatimago.common-lisp.lisp.ibclとはなにか

 com.informatimago.common-lisp.lisp.ibclは、Pascal Bourguignon氏作のイメージ指向でCommon Lispを使うためのユーティリティです。

パッケージ情報

パッケージ名com.informatimago.common-lisp.lisp.ibcl
Quicklisp

インストール方法

(ql:quickload :com.informatimago.common-lisp.lisp.ibcl)

試してみる

 ibclとはImage based Common Lispの略とのことで、Common LispをSmalltalkのようにイメージ指向で使うことを支援する環境になります。
どんなユーティリティがあるかというと、exportされているのは、

  • symbols-with-sources
  • source
  • list-sources
  • list-packages-with-sources
  • *source-types*
  • save-sources

位ですが、clパッケージに対応するibclと、cl-userに対するibcl-userは定義時のソースコードを記録するようになっています。

(cl:in-package :ibcl-user)

(defpackage :latumofis (:use :ibcl))

(cl:in-package :latumofis)

(defun lomilwa (x) (montino x)) ;==> (PROGN (SETF (SOURCE 'LOMILWA ':FUNCTION) '(DEFUN LOMILWA (X) (MONTINO X))) (CL:DEFUN LOMILWA (X) (MONTINO X)))

(defun montino (x) x)

(source 'lomilwa :function) ;=> (DEFUN LOMILWA ; (X) ; (MONTINO X)) ; #<PACKAGE "MAKANITO">

(source 'montino :function) ;=> (DEFUN MONTINO ; (X) ; X) ; #<PACKAGE "MAKANITO">

(list-sources) ; (DEFINE-CONDITION IBCL::SIMPLE-PACKAGE-ERROR (PACKAGE-ERROR SIMPLE-ERROR) ; NIL) ; #<PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.LISP.IMAGE-BASED-COMMON-LISP">) ; ((IBCL::NORMALIZE-PACKAGE-DESIGNATOR :FUNCTION) ; (DEFUN IBCL::NORMALIZE-PACKAGE-DESIGNATOR ; (PACKAGE) ; (LET ((IBCL::PACK (CL:FIND-PACKAGE PACKAGE))) ; (IF IBCL::PACK ; (PACKAGE-NAME IBCL::PACK) ; (ERROR 'IBCL::SIMPLE-PACKAGE-ERROR :PACKAGE PACKAGE :FORMAT-CONTROL ; ...

(list-packages-with-sources) ;=> (#<PACKAGE "LATUMOFIS"> ; #<PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.LISP.IMAGE-BASED-COMMON-LISP-USER"> ; #<PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.LISP.IMAGE-BASED-COMMON-LISP"> ; #<PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.LISP.CL-SAVING-DEFINES"> ; #<PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.LISP.SOURCE"> #<PACKAGE "SWANK-REPL"> ; ...

という感じで定義とソースを管理でき、save-sourcesでファイルに書き出せます。

(save-sources "/tmp/latumofis.lisp" :line-spacing 2)
  • latumofis.lisp
;;;; -*- mode:lisp -*-
;;;; Generated from sources saved by COM.INFORMATIMAGO.COMMON-LISP.LISP.SOURCE

(in-package "LATUMOFIS")

(defun lomilwa (x) (montino x))

(defun montino (x) x)

;;;; THE END ;;;;

 以上ように定義のソースコードはイメージの中に残るので、イメージをダンプすればソースを編集して再定義することも可能です。

編集にはソース全体をファイルに書き出しても良いでしょうし、定義をエディタに渡してどうにかすることもできそうです。

まとめ

 今回は、com.informatimago.common-lisp.lisp.ibclを紹介してみました。
Interlisp-DはSmalltalkと同じマシンで稼動し、同じようにイメージ指向でしたが、プロジェクトを書き出すmake-packageというユーティリティがあり、依存関係等を管理しつつ書き出したい定義を選択してファイルにまとめてくれるというものでした。
com.informatimago.common-lisp.lisp.ibclを使えば、make-packageのようなことが可能になりますね。

Stanford MacLISP: utilの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の328日目です。

Stanford MacLISP: utilとはなにか

 Stanford MacLISP: utilは、Stanford大学のMacLISPのユーティリティです。恐らく作者は、Richard Gabriel氏だと思われます。

パッケージ情報

パッケージ名Stanford MacLISP: util
参考サイトUTIL.2[AID,LSP]-www.SailDart.org

インストール方法

 上記サイトからダウンロードして適当に動かします。

 Common Lispに移植してみたものがありますので良かったらどうぞ(動作確認できれば良いという程度の移植です)

試してみる

 日付は、1981-04-22なのでMacLISPにしては案外新しいようですが、上記のサイトのソースを眺めてもらうと分かるように、なんだか分からないLisp方言となっています。
異様な見た目の原因は、Richard Gabriel氏が使っていた俺構文なのですが、MacLISPにInterlisp的な構文を取り入れつつASCII以外の文字も使っていることに起因するようです。
例えばletはこう書きます。

(let x ← 42 do
  x)
;=>  42

 またパタンマッチを多用しているのも特徴でマクロもパタンマッチで書けるmatch-macroというものが沢山使われています。
match-macroの大まかな説明をすると、構文要素をパタン変数にマッチさせて、パタン変数以外をクォートするcodeという構文で包んだコードと合体させるという方式になっています。下記のifでは、

(match-macro (if) (*form1 then *form2)
  (cond ((%match '(*form2 else *form3) *form2)
         (code (cond (*form1 *form2)
                     (t *form3))))
        (t (code (cond (*form1 *form2))))))

(let *form1 ← '(pred) do (let *form2 ← '(con) do (let *form3 ← '(alt) do (CONS 'COND (CONS (APPEND *FORM1 (APPEND *FORM2 NIL)) (CONS (CONS 'T (APPEND *FORM3 NIL)) NIL)))))) ;=> (COND (PRED CON) (T ALT))

(let *form1 ← '(pred) do (let *form2 ← '(con) do (CONS 'COND (CONS (APPEND *FORM1 (APPEND *FORM2 NIL)) NIL)))) ;=> (COND (PRED CON))

マッチ具合によって展開が変わります。

 このmatch-macroで使われている%matchですが、ガードが使えるのが1980年当時としてはなかなか先進的な気がします。

(multiple-value-bind (?x *xs ?y) nil
  (%match '(?x *xs) '(1 2 3 4))
  (list ?x *xs))
;=>  (1 (2 3 4))

(multiple-value-bind (?x *xs ?y) nil (%match '(?x *xs ($r ?y evenp)) '(1 2 3 4)) (list ?x *xs ?y)) ;=> (1 (2 3) 4)

(multiple-value-bind (?x *xs ?y) nil (%match '(?x *xs ($r ?y oddp)) '(1 2 3 4)) (list ?x *xs ?y)) ;=> (NIL NIL NIL)

ということで種類ごとに適当に眺めてみます。

制御構文

 ifはthenとelseをキーワードを使います。

(if (zerop (random 2)) then 42 else 32)
;=>  42

 その他、Interlispのselectに影響を受けたselect、select=、select-matchがあります。

(select "foo"
  ("bar" "bar")
  ("foo" "foo")
  "baz")
;=>  "foo"

(select= 42 (42 "bar") (97 "foo") "else") ;=> "bar"

(let ?x ← nil do (let ?y ← nil do (let ?z ← nil do (select-match '(1 2 3) ((?x ?y ?z) (list ?x ?y ?z)) "else")))) ;=> (1 2 3)

繰り返し

 繰り返し構文も大体定番な感じですが、キーワードのdoが特徴的です。単純な繰り返しのrepeat/while/untilの他にInterlispのforに影響を受けた汎用的なforがあります。for x in xsをfor x ∈ xsと書けます。

(repeat 10 do (princ "."))
;>>  ..........
;=>  NIL
              

(until (zerop (random 3)) do (print "foo") return (print "1") (print "2") 10) ;>> ;>> "foo" ;>> "foo" ;>> "foo" ;>> "foo" ;>> "foo" ;>> "1" ;>> "2" ;=> 10 (while (zerop (random 3)) do (print 'foo))

;>> ;>> FOO ;>> FOO ;=> NIL

(let list ← '(1 2 3 4) do (for x ∈ list collect (list x))) ;=> ((1) (2) (3) (4))

(for x from 1 to 5 by 2 do (print x)) ;==> (DO ((X 1 (+ X 2))) ((< 5 X)) (PRINT X)) ;>> ;>> 1 ;>> 3 ;>> 5 ;=> NIL

(for x ∈ '(1 2 3 4) select (oddp x)) ;==> (MAPCAN (LAMBDA (X) (AND (PROGN (ODDP X)) (LIST X))) '(1 2 3 4)) ;=> (1 3)

(for x ∈ '(1 2 3 4) scan (print x)) ;>> ;>> 1 ;>> 2 ;>> 3 ;>> 4 ;=> NIL

(for x ∈ '(1 2 3 4) do (print x)) ;>> ;>> 1 ;>> 2 ;>> 3 ;>> 4 ;=> (1 2 3 4)

末尾再帰を最適化するdefun

 Clojureのloop/recurと似た感じですが、式を分析してgotoに変換します。
Clojureのrecurに相当するのは、tail-recurキーワードです。
実行していることは、Let Over Lambdaのnamed-letとほぼ同じですが、1980年に既にあったというのは面白いですね。

(tail-recursive-defun fib (n a1 a2)
  (cond ((zerop n) a2)
        ((= 1 n) a1)
        (t (tail-recur (1- n) (+ a1 a2) a1))))

(fib 100 1 0) ;=> 354224848179261915075

まとめ

 今回は、Stanford MacLISP: utilを紹介してみました。
現状はコードの断片が残っているのみで、使い方の説明も構文の使われ方の説明もないので、基本的にさっぱり分かりませんが、コードは大体復元して動かして確認してみたので上記の説明で大体合ってるんじゃないかなと思います。

local-time-durationの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の327日目です。

local-time-durationとはなにか

 local-time-durationは、Webcheckout, Inc.作のlocal-timeと親和性の高く、timestamp形式が利用可能な期間を扱うライブラリです。

パッケージ情報

パッケージ名local-time-duration
Quicklisp
CLiKiCLiki: Article not found
Quickdocslocal-time-duration | Quickdocs

インストール方法

(ql:quickload :local-time-duration)

試してみる

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

 定義されている関数は下記の通りですが、大体名前から使い方が想像できます。

  • duration/=
  • duration/
  • duration-
  • duration
  • duration<=
  • duration-minimum
  • timestamp-difference
  • parse-iso8601-duration
  • duration>=
  • duration>
  • duration<
  • duration-maximum
  • duration+
  • duration-as
  • duration*
  • duration=
  • human-readable-duration
  • timestamp-duration+
  • timestamp-duration-

 2015年の1月1日から現時刻の期間を求めて、その期間分過去に戻ったtimestampを得るとするとこんな感じになります。

(let* ((now (local-time:now))
       (d (ltd:timestamp-difference (local-time:encode-timestamp 0 0 0 0 1 1 2015)
                                    now)))
  (ltd:timestamp-duration- now d))
;=>  @2016-10-14T00:00:00.000000+09:00

三週間後のタイムスタンプは、

(ltd:timestamp-duration+ (local-time:now)
                         (ltd:duration :week 3))
;=>  @2015-12-14T00:00:00.000000+09:00

等、シンプルです。

まとめ

 今回は、local-time-durationを紹介してみました。
local-timeと組み合せて手軽に期間が扱えて便利ですね。

srfi 86の紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の326日目です。

srfi 86とはなにか

 srfi 86は、Joo ChurlSoo氏による究極の束縛構文の提案です。

パッケージ情報

パッケージ名srfi 86
SRFISRFI 86: MU and NU simulating VALUES & CALL-WITH-VALUES, and their related LET-syntax

インストール方法

 SagittariusとRacketでは標準で使えます。

;;; Sagittarius
(import (srfi 86))

;;; Racket (require srfi/86)

試してみる

の記事の使い回しなのですが、コード例をSchemeで動くように書き換えるとこんな感じになります。

多値 & 分配束縛

 muが多値でnuがリストという感じです。

(alet (a (mu 1 2)
        ((b c) (mu 3 4)))
  (list a b c))
;=> ((1 2) 3 4)

(alet (((a . b) (nu '(1 2 3 4)))) (list a b)) ;=> (1 (2 3 4))

(alet (((values a b) (values 3 4))) (list a b)) ;=> (3 4)

名前付きLET

 ノーマルなnamed-letの形式に加え、束縛部のリストの終端に名前を持ってくるという斬新な手法により複数の関数を扱えるようにしてあります。さらに謎のネストも可能

(alet* tag ((a 1)
            (a b b c (mu (+ a 2) 4 5 6))
            ((d e e) b 5 (+ a b c)))
  (if (< a 10)
      (tag a 10 b c c d e d)
      (list a b c d e)))
;=> (10 6 6 5 5)

(alet fact ((n 10) (a 1))
  (if (zero? n)
      a
      (fact (- n 1) (* a n))))
;=> 3628800

;; 名前が後ろにある形式の名前付きLET

(alet (((n 10) (a 1) . fact))
      (if (zero? n)
          a
          (fact (- n 1) (* a n))))
;=> 3628800

;; intagとtagで入れ子
(alet* ((a 1)
        ((b 2)
         (b c c (mu 3 4 5))
         ((d e d (mu a b c)) . intag)
         . tag)
        (f 6))
  (if (< d 10)
      (intag d e 10)
      (if (< c 10)
          (tag b 11 c 12 a b d intag)
          (list a b c d e f))))
;=> (1 11 12 10 3 6)

継続関係

 call/ccの糖衣構文であるlet/cc的なものもサポート。

; 脱出(継続)
(alet lp ((win)
          (list '(1 2 3 4 5 6 7)))
  (cond ((= 3 (car list))
         (win (car list)))
        (else (print (car list))
              (lp win (cdr list)))))
;->
;   1
;   2
;=> 3

and-let*

 and-let*も貪欲に取り込み

;; and-let*
(alet* ((alist '((a . 1) (b . 2) (c . 3)))
        (and (a (assoc 'b alist))))
  (cdr a))
;=> 2

Common Lispのlambda-list的なものをサポート

 Common Lispでいう&rest、&optional、&keyを越えるものをサポート。キーワードのキーとして文字列も使えます。

;; キーワードで分配
(alet ((key '(b 20 a 10 c 30)
            (a :init)
            (b :init)
            (c :init)
            (d :init)))
  (list a b c d))
;=> (10 20 30 :init)

;; Common Lispのdestructuring-bindとの比較 (destructuring-bind (&key ((a a) :init) ((b b) :init) ((c c) :init) ((d d) :init)) '(b 20 a 10 c 30) (list a b c d)) ;=> (10 20 30 :INIT)

;; もっとエグい (alet ((key '(:a 10 :cc 30 40 b 20) ((a :a) 1) ((b :b) 2) ((c :cc) 3) . d)) (list a b c d)) ;=> (10 2 30 (40 b 20))

;; 文字もキーにできる (alet ((key '("a" 10 "cc" 30 40 b 20) ((a "a") 1) ((b "b") 2) ((c "cc") 3) . d)) (list a b c d)) ;=> (10 2 30 (40 B 20))

letrec系

 letrec形式も勿論サポート

(alet ((rec (fact (lambda (n)
                    (if (zero? n)
                        1
                        (* n (fact (- n 1))))))))
  (fact 10))
;=> 3628800

その他

(let ((a #f) (b #f))
  (alet ((a :a)
         (b :b)
         (() (set! a 100)
             (set! b 200)))
    (list a b)))
;=> (:a :b)
(let (a b) (set! a 100) (set! b 200)
        (alet ((a :a) (b :b))
              (list a b)))
;=> (:a :b)

(let ((a #f) (b #f))
  (alet* ((a :a)
          (b :b)
          (() (set! a 100)
              (set! b 200)))
    (list a b)))
;=> (100 200)
(let (a b)
     (alet* ((a :a) (b :b))
            (set! a 100)
            (set! b 200)
            (list a b)))
;=> (100 200)

(alet ((cat '(1 -2 3) (a 0 (positive? a)) (b 0 (positive? b)) (c 0 (positive? c)) . d)) (list a b c d)) ;=> (1 3 0 (-2))

色々複合した例

(let ((m #f) (n #f))
  (alet* ((a (begin (display "1st") 1))
          ((b c) 2 (begin (display "2nd") 3))
          (() (set! m #f) (set! n (list 8)))
          ((d (begin (display "3rd") 4))
           (key '(e 5 tmp 6) (e 0) ((f 'tmp) 55)) . p)
          g (nu (begin (display "4th") 7) n)
          ((values . h) (apply values 7 (begin (display "5th") n)))
          ((m 11) (n n) . q)
          (rec (i (lambda () (- (j) 1)))
               (j (lambda ()  10)))
          (and (k (begin (display "6th") m))
               (l (begin (display "end") (newline) 12)))
          (o))
    (if (< d 10)
        (p 40 50 60)
        (if (< m 100)
            (q 111 n)
            (begin (display (list a b c d e f g h
                                  (i)
                                  (j)
                                k l m n))
                   (newline))))
    (o (list 'o p q))
    (display "This is not displayed")))
;-> 1st2nd3rd4th5th6thend
;-> 4th5th6thend
;-> 6thend
;-> (1 2 3 40 50 60 (7 8) (7 8) 9 10 111 12 111 (8))
;=> (o #<closure #<identifier p#user>> #<closure #<identifier q#user>>)

まとめ

 今回は、srfi 86を紹介してみました。
Joo ChurlSoo氏のSRFIは面白いものが多いのですが、紹介するのもなかなか大変です。

1amの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の325日目です。

1amとはなにか

 1amは、James M. Lawrence氏作のシンプルなfiveam風のテストフレームワークです。

パッケージ情報

パッケージ名1am
Quicklisp
CLiKiCLiki: Article not found
Quickdocs1am | Quickdocs

インストール方法

(ql:quickload :1am)

試してみる

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

 1amは約60行程のコードとのことですが、マルチスレッドな大きめのプロジェクトでは、良く知られたテストフレームワークでは問題が起きていたとのことで、これを解消するためシンプルが一番という哲学で作られたもののようです。
特長として説明があるのは、

  • テストの失敗時点でテストが停止する(ブレイクポイントで中断)
  • テスト順に依存したバグを排除するためテストは都度シャッフルして実行される
  • テストケースはテスト名と同名の関数になる
  • 先にコンパイルしてから実行する
  • 速い(fiveamの約8倍)

とのことです。
書式はfiveamとほぼ同じなので、手元でfiveamで書いていて遅いと感じていたものを1amに置き換えてみましたが、かなり速くなりました。

ASDFとの連携

 1amの仕組みは、1am:*tests*にテストの関数を詰め込んで実行するという素朴なものです。
fiveamのようにテストをsuiteごとに管理するのではなく、基本的には大域的にこの一つのみです。管理しようと思えばできなくもない感じではありますが。
他のプロジェクトとの競合を予防する場合、テストファイルの中に、1am:*tests*を初期化するコードを入れるか、asdf:prepare-opで初期化したりすることになるのかなと思います。
テストの呼び出しはrunのみなのでASDFでの記述はシンプルです。

(cl:in-package :asdf)

(defsystem :foo :serial t :depends-on (:1am ...) :components (...) :in-order-to ((test-op (load-op ...))) :perform (prepare-op :before (o c) (set (find-symbol* :*tests* :1am) '() )) :perform (test-op (o c) (let ((*package* (find-package ...))) (symbol-call :1am :run))))

*package*を書いているのは、テスト関数は、通常の関数なので大域変数に影響を受けることになるためです。
パッケージやリードテーブルに影響を受ける印字系のプログラムではテスト関数内で影響を受けないように書くか、このようにtest-opで保護するかになるかと思います。

まとめ

 今回は、1amを紹介してみました。
なかなかシンプルで良いかもしれません。

MIT Lisp Machine: Hierarchical Packagesの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の324日目です。

MIT Lisp Machine: Hierarchical Packagesとはなにか

 MIT Lisp Machine: Hierarchical Packagesは、MIT Lisp Machineのパッケージシステムです。

パッケージ情報

パッケージ名MIT Lisp Machine: Hierarchical Packages
LispマシンマニュアルLisp Machine Manual 6th ed.: Packages

試してみる

 それまでのoblistでのシンボルの管理をパッケージにまとめて大規模な開発を可能にしたのがLispマシンのパッケージかと思います。
仕組みが固定し初めたのは大体1978年位でしょうか。
Common Lispのパッケージの関数と並べると下記のようになります。

  • package-declare / defpackage
  • pkg-create-package / make-package
  • pkg-name / package-name
  • symbol-package / symbol-package
  • pkg-find-package / find-package
  • kill-package / delete-package
  • pkg-goto / in-package
  • pkg-bind / (let ((*package* pkg)) ...)

階層パッケージ

 一見してCommon Lispと比較して違うところは、階層を成しているということです。
初期状態の階層は下記の通り

                           global                     keyword
                             |                          
       /-----------------------------------          fonts
       |     |          |          |       |
     user  zwei      system      format  (etc)        cli
                        |
                /----------------------------------
                |          |     |     |    |      |
         system-internals  eh  chaos  cadr  fs  compiler

 下記のように書くことで階層分けが可能です。

(package-declare aaa global 100 nil) 
(package-declare bbb aaa 100 nil)
(package-declare ccc bbb 100 nil)

こうすると、aaaの下にbbb、bbbの下にcccが作られるので、cccのシンボルdは、aaa:bbb:ccc:dということになります。
ちなみに、Common Lispのようにエクスポートしないとpkg::symと記述しなければいけないということはありません。
シンボルの継承は、上から下に勝手に継承してきます。つまり、

(intern "X" "AAA")
(eq 'aaa:x 'aaa:bbb:ccc:x)
;=> T

みたいなことになります。
これを防ぐのがCommon Lispと同じくshadowで

(shadow "X" 'aaa:bbb:ccc)

(eq 'aaa:x 'aaa:bbb:ccc:x) ;=> NIL

とできます。しかし、

(eq 'aaa:z 'aaa:bbb:ccc:z)
;=> T

でも

(eq 'aaa:bbb:ccc:q 'aaa:q)
;=> NIL

だったりして、評価順が関係してきてややこしいです。

keywordパッケージはuser

 パッケージシステムができた当初(というかCommon Lisp登場まで)はkeywordパッケージというものはなく、:fooと書けば、user:fooのことでした。
更に、自己評価オブジェクトでもなかったのでクォートを付ける必要がありました。
昔のコードで ':foo と書いてあることがあるのは、このためです。
この為、userパッケージはサブパッケージが作れない等の制限をつけていたようなのですが、Common Lispが出てくるあたりでkeywordパッケージもできたようです。

パッケージの指定は、-*- Packge: -*-で行なう

 上記の一覧では、pkg-gotoというものがありますが、基本的にパッケージの宣言は、ファイル最上部の属性リストで宣言していました。

階層パッケージの活用され具合

 Lispマシンのソースを眺める限りでは、特に階層分けを活かしたコードというのは無かったようです。
上部のパッケージから無条件でシンボルを継承してくるというのが良くなかったのか、何が悪かったのかは不明ですが、そんな為か、Common Lispをサポートする辺りになってくると、'aaa:bbb:ccc:xも'ccc:xも同じ意味になったりしていて、これだと実質パッケージ名はグローバルに唯一のものしか付けられなくなってきます。

面白い機能

 Common Lispには無い機能として、relative-names/relative-names-for-me、invisibleがあります。
relative-namesは、SBCLのlocal-nicknamesと同じで他のパッケージをパッケージローカルで別名で参照できます。
relative-names-for-meはその逆みたいですが詳細は不明です。
invisibleは、(list-all-packages)には登録されないということで、シンボルでいうuninterned symbolみたいな感じです。名前は付くもののfind-packageでは見付けられません。

まとめ

 今回は、MIT Lisp Machine: Hierarchical Packagesを紹介してみました。
不特定多数の人がバラバラに開発をしつつも統一しようとすれば、Perl/CPANのような名前の階層化が便利なのかなと思いますが、どうなのでしょう。
Common Lispの場合は、パッケージ名の衝突を回避する方法が面倒なのが厄介ですね。

Allegro CL: Hackable LAP codeの紹介

Posted 2014-11-18 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の323日目です。

Allegro CL: Hackable LAP codeとはなにか

 Allegro CL: Hackable LAP codeは、Allegro CLでコンパイラの出力をいじる仕組みです。Hackable LAP codeというかどうかは分かりませんが、Erik Naggum氏の話の中でこういう表現があるので、とりあえずこう呼ぶことにしてみます。

パッケージ情報

パッケージ名Allegro CL: Hackable LAP code

インストール方法

 Allegro CLに標準の機能です。Allegro CL 4.3でも使えるのでかなり古くから(遅くとも1997年位から)あるようです。

試してみる

 件のHackable LAP codeという呼び方ですが、

に出てくるものです。

 この機能については正式なドキュメントがないようなのですが、ILC 2007のDuane Rettig氏のチュートリアルで解説があったようです。

コンパイラの出力を編集する

 編集の仕方が黒魔術的なのですが、下記の手順で行ないます。
とりあえず、手短なところで与えられた引数をそのまま返すidという関数を定義してみます。

(defun id (obj) obj)

Common Lispのidentityと機能は同じものですが、コンパイル時にフックが掛ってLAPを編集するのでコンパイルはしないで置きます。

 何もしない場合のdisassembleの結果は下記のようになります。

(disassemble #'id)
;>>  ;; disassembly of #<Function ID>
;>>  ;; formals: OBJ
;>>  
;>>  ;; code start: #x1001229d68:
;>>     0: 48 83 f8 01    cmp	rax,$1
;>>     4: 74 01          jz	7
;>>     6: 06             (push es)       ; SYS::TRAP-ARGERR
;>>     7: 41 80 7f a7 00 cmpb	[r15-89],$0 ; SYS::C_INTERRUPT-PENDING
;>>    12: 74 01          jz	15
;>>    14: 17             (pop ss)        ; SYS::TRAP-SIGNAL-HIT
;>>    15: f8             clc
;>>    16: 4c 8b 74 24 10 movq	r14,[rsp+16]
;>>    21: c3             ret
;>>  
;=>  <no values>

 次にコンパイル時にLAPを編集する関数を指定します。

(setq comp::*hack-compiler-output* '(id))

 そしてコンパイルすると、hackit.sができるので、これをエディタで編集します。

(let ((*default-pathname-defaults* #P"/tmp/"))
  (compile 'id))
;>> type :cont when you're done editing "hackit.s"
;>>    [Condition of type SIMPLE-BREAK]
;>> 
;>> Restarts:
;>>  0: [CONTINUE] return from break.
;>>  1: [RETRY] Retry SLIME interactive evaluation request.
;>>  2: [*ABORT] Return to SLIME's top level.
;>>  3: [ABORT] Abort entirely from this (lisp) process.

hackit.sは、こんな感じの内容になっています。

(LABEL GARBAGE::L2)
(CMP.Q (IM 1) (:REG 0 :RAX :EAX :AX :AL))
(BCC :EQ GARBAGE::L3)
(TRAP.WNAERR)
(LABEL GARBAGE::L3)
(LABEL GARBAGE::L1)
(CMP.B (IM 0) (D -89 (:REG 15 :R15 :R15D :R15W :R15B)))
(BCC.S :EQ GARBAGE::L4)
(TRAP.SIGNAL-HIT)
(LABEL GARBAGE::L4)
(CLC)
(MOVE.Q (D 16 (:REG 4 :RSP :ESP :SP :SPL))
        (:REG 14 :R14 :R14D :R14W :R14B))
(RETURN)

大体上のアセンブリの出力と対応しているのが分かります。
これを適当に編集しますが、Allegro CLでは、RAXにアリティが入るようで、これが1個かどうかをチェックしているようです。
試しにこれを削除してみます。

(CLC)
(MOVE.Q (D 16 (:REG 4 :RSP))
        (:REG 14 :R14))
(RETURN)

 これだと何もしてないように見えますが、返り値が置かれるレジスタが第一引数が置かれるレジスタと同じなのでOKです。
なお、レジスタの指定は、番号が重要で、レジスタの名前はコメントのようなので上のように書いても大丈夫みたいです。
編集し終わったら継続してコンパイル完了です。

(id 42 1 38 8)
;=> 42

(disassemble #'id) ;>> ;; disassembly of #<Function ID> ;>> ;; formals: OBJ ;>> ;>> ;; code start: #x1003749a98: ;>> 0: f8 clc ;>> 1: 4c 8b 74 24 10 movq r14,[rsp+16] ;>> 6: c3 ret ;>> 7: 90 nop ;>> ;=> <no values>

引数をチェックしていない関数になりました。

コンパイル時に用意したLAPを結合させる

 これで編集できることは分かったのですが、これを毎度やるのは現実的ではない、ということで、ファイルを読み込ませる方法もあります。

(setq comp::*assemble-function-body* '((id . #P"/tmp/id.s")))

(compile ...)

(setq comp::*assemble-function-body* nil)

LAPを直接編集して高速化した関数の速度計測

 さてidが、identityより速いのか計測してみましょう。

(time
 (dotimes (i 1000000000)
   (id 1)))
; cpu time (non-gc) 4.784000 sec user, 0.000000 sec system
; cpu time (gc)     0.000000 sec user, 0.000000 sec system
; cpu time (total)  4.784000 sec user, 0.000000 sec system
; real time  4.784323 sec
; space allocation:
;  54 cons cells, 5,232 other bytes, 0 static bytes

(time (dotimes (i 1000000000) (identity 1))) ; cpu time (non-gc) 1.276000 sec user, 0.000000 sec system ; cpu time (gc) 0.000000 sec user, 0.000000 sec system ; cpu time (total) 1.276000 sec user, 0.000000 sec system ; real time 1.276108 sec ; space allocation: ; 0 cons cells, 0 other bytes, 0 static bytes

3倍位遅いwwwww
identityより遅い理由ですが、identityにはコンパイラマクロが定義してあって、identity自体がいなくなるので、上記のコードのような場合、identityとしては最速の実装ということになります。
さすがになかなか賢いですね。

 ちなみに、idを(speed 3)(safety 0)で最適化すると引数チェックが消えて上記のLAPコードと同じものになるので、引数チェックを無くすためであれば、わざわざLAPコードを編集する必要はありません。

まとめ

 今回は、Allegro CL: Hackable LAP codeを紹介してみました。
なかなか黒魔術的な機能で良いですね。Allegro CLにはこういうのが他にも沢山あるようです。

Allegro CL Examples and Utilities: English-Word-Stemmerの紹介

Posted 2014-11-17 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の322日目です。

Allegro CL Examples and Utilities: English-Word-Stemmerとはなにか

 Allegro CL Examples and Utilities: English-Word-Stemmerは、Steven M. Haflich氏作の英語単語のステマーです。

パッケージ情報

パッケージ名Allegro CL Examples and Utilities: English-Word-Stemmer
Quicklisp×
配布サイト(archive.org)Allegro CL Examples and Utilities

インストール方法

 Franzのサイトからダウンロードできたりするのですが、しばらく落ちたままなので、archive.orgを紹介しておきます。

試してみる

  単語から接辞語を取り除く処理をステミングというみたいですが、利用されているアルゴリズムは、Porter Stemming Algorithmとのことで定番のもののようです。
stemを使えば、こんな感じに処理してくれます。

(mapcar #'stem
        (*:split-sequence #\Space "seven steps to heaven"))
;=>  ("seven" "step" "to" "heaven")

まとめ

 今回は、Allegro CL Examples and Utilities: English-Word-Stemmerを紹介してみました。
作者のSteven M. Haflich(smh)氏は、LMIからFranzと渡り歩きANSI Common Lispの仕様策定でも活躍したLispハッカーです。
ステマーのコード中で、

(block nil
  (case (char str (1- (length str)))
    (#\e (when (ends str "icate") (r str "ic" sfp) (return))
     (when (ends str "ative") (r str "" sfp)   (return)) ; huh?
     (when (ends str "alize") (r str "al" sfp) (return)))
    (#\i (when (ends str "iciti") (r str "ic" sfp) (return)))
    (#\l (when (ends str "ical")  (r str "ic" sfp) (return))
     (when (ends str "ful")   (r str "" sfp)   (return))) ; huh?
    (#\s (when (ends str "ness")  (r str "" sfp)   (return))) ; huh?
    ))

のようなコードに遭遇し、「流石熟練Lispハッカーはやることが違う!」と思いましたが、コメントを良く読んだらCから手作業で機械的に移植したとのことでした。

QITAB: strict-functionsの紹介

Posted 2014-11-16 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の321日目です。

QITAB: strict-functionsとはなにか

 QITAB: strict-functionsは、ITAで利用されている引数や返り値の型、発生するコンディションのチェック機能付きの関数/メソッドを定義するためのライブラリです。

パッケージ情報

パッケージ名QITAB: strict-functions
Quicklisp×
プロジェクトサイトQITAB - a collection of free Lisp code

インストール方法

 common-lisp.netからITAで利用されているユーティリティのスナップショットが入手できるので、これをダウンロードします。

目的のファイルは、quux/lisp/quux/strict-functions.lisp あたりのファイルです(結構色々なファイルに散らばっています。)

試してみる

 関数のドキュメンテーションが詳細なので掲載してみます。

DEFINE-STRICT-FUNCTION names a macro:
  Lambda-list: (NAME
                (&KEY INPUTS (OUTPUTS NIL ANY-OUTPUTS) CONDITIONS
                 COUNT-P)
                &BODY BODY)
  Documentation:
    Define a function (like defun) with strict input, output and signal typing.

'name' - symbol naming the function

'inputs' - a "strict lambda list". Similar to a regular defun lambda-list, however every atom/expression PARAM which describes a parameter value is now a list (PARAM TYPE &optional DOC), where TYPE is a type expression which constrains the type of that parameter and DOC is an optional DOCSTRING describing the parameter. For &rest arguments, TYPE is a type expression that constrains the type of all following parameters.

'outputs' - a list of type expressions which constrain the types of values returned by the function, one type per value, as would be seen by the caller. The function is not allowed to return more values those described by this list. If there is no outputs argument, then any returned values are OK; use this when the function is called only for side effect and the returned value should be ignored.

'conditions' - a list of the conditions which this function is allowed to signal. If 't' is in this list, any condition is allowed.

'count-p' - true or nil: if true, result counts are maintained. Specifically, when function exits with a condition of type not listed in :CONDITIONS argument it is counted as an error, and otherwise as an success. This is for reporting by the /stat/request monitor facility, intended to be used by operators. By convention, count-p is specified true for QRes functional entry points, i.e., by define-qres-functional-entry-point, otherwise nil.

'body' - the body of the function (as in DEFUN, the first form may be a documentation string).

Type declarations are automatically prepended to the function body for each of the input parameters. Violations of input type declarations are signalled as a STRICT-FUNCTION-INPUT-TYPE-ERROR via #'ERROR.

If the function attempts to return a more values than declared by :outputs, then a STRICT-FUNCTION-OUTPUT-COUNT-ERROR is signalled via #'ERROR. Likewise, If the function attempts to return a value with a type incompatible with that declared by :outputs, then a STRICT-FUNCTION-OUTPUT-TYPE-ERROR is signalled via #'ERROR.

The strict-function wrapping will catch any signals which are not declared by :conditions and signal the STRICT-FUNCTION-CONDITION-ERROR via #'ERROR if it matches *strict-function-condition-signal-typespec* (which defaults to NIL).

Example:

(define-strict-function foo (:inputs ((x keyword) &optional ((y 57) integer)) :outputs (integer string) :conditions (bad-foo-error)) (case x (:ANIMAL (values y "elephants")) (:MINERAL (values (* 2 y) "rocks")) (t (error (make-condition 'bad-foo-error)))))

(define-strict-function bar (:inputs ((x t)) :outputs (string) :conditions ()) (format nil "bar sez: ~A" x))

 オプションのうちcount-pというのがQResシステムに密着気味ですが、他は汎用的かなと思います。
とりあえず、define-strict-functionの方は、

(define-strict-function fib (:inputs ((n (integer 0 *)))
                             :outputs (integer))
  (if (< n 2)
      n
      (+ (fib (1- n))
         (fib (- n 2)))))
(fib :z)
;!> The value of argument N to FIB was :Z but it was expected to be of type (UNSIGNED-BYTE
;!>                                                                          62)
;!>    [Condition of type STRICT-FUNCTION-INPUT-TYPE-ERROR] 

という感じです。
コンディションを指定する場合は、

(setq *strict-function-condition-signal-typespec* T)

(define-condition morlis () ())

(define-strict-function latumapic (:inputs () :outputs (null) :conditions (morlis)) (warn "大丈夫か日本"))

(latumapic) ;!> The condition #1# was erroneously signalled in LATUMAPIC: ;!> #1=大丈夫か日本 ;!> [Condition of type STRICT-FUNCTION-CONDITION-ERROR]

という感じで、指定したコンディション以外が発生するとSTRICT-FUNCTION-CONDITION-ERRORになります。

 define-strict-methodの方は、


(define-strict-generic fib (:inputs ((n integer))
                           :outputs ((integer 0 *))))

(define-strict-method fib (:inputs ((n (eql 0))) :outputs ((integer 0 *))) 0)

(define-strict-method fib (:inputs ((n (eql 1))) :outputs ((integer 0 *))) 1)

(define-strict-method fib (:inputs ((n integer)) :outputs ((integer 0 *))) (+ (fib (1- n)) (fib (- n 2))))

(fib -1) ;!> The condition #1# was erroneously signalled in FIB: ;!> #1=Control stack exhausted (no more space for function call frames). ;!> This is probably due to heavily nested or infinitely recursive function ;!> calls, or a tail call that SBCL cannot or has not optimized away. ;!> ;!> PROCEED WITH CAUTION. ;!> [Condition of type STRICT-FUNCTION-CONDITION-ERROR]

という感じです。
ちょっと判りづらいですが、メソッドの方は、スタックが溢れてエラーになっているので、STRICT-FUNCTION-CONDITION-ERRORになっています。

まとめ

 今回は、QITAB: strict-functionsを紹介してみました。
QITAB: strict-functionsのことを初めて識ったのは、 Steve Yegge氏のブログエントリーにDan Weinreb氏が寄せたコメントでした(ちなみにブログのコメントにしては恐しく長文)。

どんなものか適当に想像して作ってみたりしたこともありました(#:g1: CLでのDylan風定義とCLOS系言語での型指定書法の比較)が、実物はかなりゴツい感じですね。

split-sequenceの紹介

Posted 2014-11-15 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の320日目です。

split-sequenceとはなにか

 split-sequenceは、Sharp Lispers作のシークエンスをデリミタで分割するライブラリです。

パッケージ情報

パッケージ名split-sequence
Quicklisp
CLiKiCLiki: SPLIT-SEQUENCE
Quickdocssplit-sequence | Quickdocs
CL Test Grid: ビルド状況split-sequence | CL Test Grid

インストール方法

(ql:quickload :split-sequence)

試してみる

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

 1998年頃のcomp.lang.lispで初心者の質問でsplitの話題が出たらしいのですが、色々な実装がレスの中であるうちArthur Lemmens氏の実装がsplit-sequenceの元になったみたいです。
仕様と動作は、Common Lispの流儀に則ったものになっています。

(split-sequence:split-sequence #\, "foo,bar,baz")
;=>  ("foo" "bar" "baz")
;    11

(split-sequence:split-sequence-if (lambda (c) (char= #\, c)) "foo,bar,baz") ;=> ("foo" "bar" "baz") ; 11

(split-sequence:split-sequence-if-not #'alphanumericp "foo,bar,baz") ;=> ("foo" "bar" "baz") ; 11

まとめ

 今回は、split-sequenceを紹介してみました。
初心者の質問に答える形で誕生したという経緯のためか、ソースコードも非常に教育的です。
コードは短かいですが、Common Lispの流儀が学べる教材としても有用ではないでしょうか。

com.informatimago.common-lisp.lisp-reader.readerの紹介

Posted 2014-11-13 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の318日目です。

com.informatimago.common-lisp.lisp-reader.readerとはなにか

 com.informatimago.common-lisp.lisp-reader.readerは、Pascal Bourguignon氏作のANSI Common Lisp標準に準拠したリーダーの実装です。

パッケージ情報

パッケージ名com.informatimago.common-lisp.lisp-reader.reader
Quicklisp

インストール方法

(ql:quickload :com.informatimago.common-lisp.lisp-reader.reader)

試してみる

 Common Lispのリーダーを丸ごと実装しているのですが、動作はカスタマイズも可能で、リーダーと密に連携するためかCommon Lispのパッケージの実装も付属してきます。
カスタマイズは色んな方法が考えられるかと思いますが、リードテーブルにトークンの解釈をする関数が設定されているので、これをいじるだけでも結構色々なことができそうです。

 例として、標準のリーダーでは扱いが面倒臭いパッケージマーカー(:)を単なる文字として扱うようなリーダーを作成してみます。

(defun parse-token* (token)
  "
RETURN:  okp ; the parsed lisp object if okp, or an error message if (not okp)
"
  (let ((message nil))
    (macrolet
        ((rom (&body body)
           "Result Or Message"
           (if (null body)
               'nil
               (let ((vals (gensym)))
                 `(let ((,vals (multiple-value-list ,(car body))))
                    ;; (format *trace-output* "~S --> ~S~%" ',(car body) ,vals)
                    (if (first ,vals)
                        (values-list ,vals)
                        (progn
                          (when (second ,vals)
                            (setf message  (third ,vals)))
                          (rom ,@(cdr body)))))))))
      ;; (format *trace-output* "token: ~S~%" token)
      (multiple-value-bind (ok type object)
          (rom (parse-decimal-integer-token token)
               (parse-integer-token         token)
               (parse-ratio-token           token)
               (parse-float-1-token         token)
               (parse-float-2-token         token)
               ;; (parse-consing-dot-token     token)
               (parse-symbol-token*          token))
        (declare (ignorable type))
        ;; (format *trace-output* "ok = ~S ; type = ~S ; object = ~S~%"
        ;; ok type object )
        (values ok (if ok object message))))))

(defparser parse-symbol-token* (token) (accept 'symbol (intern (token-text token) *package*)))

(setf (readtable-parse-token *readtable*) #'parse-token*) ;=> #<FUNCTION PARSE-TOKEN*>

(with-input-from-string (in "(a:a:a:a b:b:b c \"a\" #'a:a:a)") (read in)) ;=> (|A:A:A:A| |B:B:B| C "a" #'|A:A:A|)

(with-input-from-string (in "(|a:a:a| :a::b::c:: ::)") (read in)) ;=> (|a:a:a| |:A::B::C::| |::|)

(readtable-parse-token *readtable*)でリードテーブルに付属のトークンを解釈する関数を読み書き可能なのでパッケージマーカーについては特に何もせず文字列をシンボルに変換するだけの関数に差し替えています。

まとめ

 今回は、com.informatimago.common-lisp.lisp-reader.readerを紹介してみました。
ほとんど標準のリーダーと同じ動作だけれど、ちょっとだけカスタマイズして使いたい、ということがありますが、パッケージマーカー等が微妙に邪魔だったりします。
この辺りを迂回できるだけでも結構便利に使えますね。

YTools: bindersの紹介

Posted 2014-11-12 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の317日目です。

YTools: bindersとはなにか

 YTools: bindersは、Drew McDermott氏のユーティリティであるYtoolsの中の束縛構文と繰り返し系のユーティリティです。

パッケージ情報

パッケージ名YTools: binders
Quicklisp×
プロジェクトページHome page for Drew McDermott
CLiKiCLiki: YTools

インストール方法

 上記プロジェクトページからダウンロードしてきて適当に導入します。

試してみる

 まず束縛構文ですが、ローカル関数を束縛するlet-funとローカル変数のlet-varsがあります。

let-fun

 let-funはlabelsに相当し、fletに相当するものにはlet-fun-nonrecというのがあります。
let-funで面白いのは、:where句が使えることで関数定義を後置可能です。
:where句の関数定義の組み合わせにより好みに応じて書き方を選べます。

(defun fib (n)
  (let-fun ((fib (n a1 a2)
              (cond ((zerop n) a2)
                    ((onep  n) a1)
                    (T (fib (1- n) (+ a1 a2) a1)))))
    (fib n 1 0)
   :where
    (:def onep (n) (= 1 n))))

(defun fib (n) (let-fun ((:def onep (n) (= 1 n))) (fib* n 1 0) :where (:def fib* (n a1 a2) (cond ((zerop n) a2) ((onep n) a1) (T (fib* (1- n) (+ a1 a2) a1))))))

(defun fib (n) (let-fun () #'fib* (fib* n 1 0) :where (:def fib* (n a1 a2) (cond ((zerop n) a2) ((onep n) a1) (T (fib* (1- n) (+ a1 a2) a1)))) (:def onep (n) (= 1 n))))

let-var

 let-varがいまいち良く分かりませんが、こんな感じです。
あまり面白味はないかも。

(let-var (((x 0) (y 0)))
  (list x y)
 :where (setq x 4))
;=>  (4 0)

repeat

 Common LispのLOOPの複雑さとLispらしくなさに対して考えられたのがrepeatです。
といっても十分複雑な気がします。
一番シンプルな使い方はこんな感じです。

(repeat :for ((i = 0 :to 9))
  :collect i)
;=>  (0 1 2 3 4 5 6 7 8 9)

これだとほぼLOOPと変わりありません。
LOOPのINTO的なものを実現するには:collector(s)と:intoの組み合わせを利用します。

(repeat :for ((i = 0 :to 9)
              :collector is)
  :collect (:into is i)
  :result is)

LOOPだとサブフォームに通常のLispフォームが出てきたら、そこから内側はLOOPの構文は使えませんが、repeatでは、:withinと:continueの組み合わせでこれを実現可能です。

(repeat :for ((i = 0 :to 9)
              :collectors odds evens)
  :within
  (if (oddp i)
      (:continue :collect (:into odds i))
      (:continue :collect (:into evens i)))
  :result (append odds evens))
;=>  (1 3 5 7 9 0 2 4 6 8)

さらに、:whereで関数定義を後置可能です。

(repeat :for ((i = 0 :then (add1 i))
              :collectors odds evens)
  :while (< i 10)
  :within
  (if (oddp i)
      (:continue :collect (:into odds i))
      (:continue :collect (:into evens i)))
  :result (append odds evens)
  :where (:def add1 (i) (+ 1 i)))

また細かいところでは、変数更新の所で同じフォームが来る場合に:againで略記が可能です。

(with-input-from-string (in "foo bar baz")
  (repeat :for ((c = (read-char in nil) :then :again))
    :while c
    :collect (char&code c)
    :where (:def char&code (c)
             (list c (char-code c)))))
;=>  ((#\f 102) (#\o 111) (#\o 111) (#\  32) (#\b 98) (#\a 97) (#\r 114) (#\  32)
;     (#\b 98) (#\a 97) (#\z 122))

 LOOPを使って記述密度が高く書けているrebinding(once-only)のコードでも比較してみます。

(defmacro rebinding (vars &body body)
  (loop for var in vars
	for name = (gensym (symbol-name var))
	collect `(,name ,var) into renames
	collect ``(,,var ,,name) into temps
	finally (return `(let ,renames
			   (*:with-unique-names ,vars
                             `(let (,,@temps)
                                ,,@body))))))

(defmacro rebinding (vars &body body) (repeat :for ((var :in vars) :collectors renames temps) :within (let ((name (gensym (symbol-name var)))) (:continue :collect (:into renames `(,name ,var)) :collect (:into temps ``(,,var ,,name)))) :result `(let ,renames (*:with-unique-names ,vars `(let (,,@temps) ,,@body)))))

repeatだと束縛部でシリアルな束縛(letに対するlet*)ができないので、letと:withinを使ってみています。letでなくてもsetqでも良いのですが。
まあそこそこの記述密度ではないでしょうか。

まとめ

 今回は、YTools: bindersを紹介してみました。
:withinと:continueのお蔭でLOOPよりはrepeatの方が既存のLisp構文と混ぜて使える感じはしますね。

CLOCC: ansi-testsの紹介

Posted 2014-11-11 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の316日目です。

CLOCC: ansi-testsとはなにか

 CLOCC: ansi-testsは、ANSI Common Lispの規格に準拠しているかどうかをテストするユーティリティです。

パッケージ情報

パッケージ名CLOCC: ansi-tests
プロジェクトサイト CLOCC - Common Lisp Open Code Collection / Hg / [5dc26c] /src/tools/ansi-test/tests.lisp

インストール方法

 CLOCCのプロジェクトサイトからダウンロードしてきて適当に導入します。

$ hg clone http://hg.code.sf.net/p/clocc/hg clocc-hg

試してみる

 対応している処理系は、ANSI Common Lispならなんでもという気もしますが、CLISP、CMUCL、SBCL、GCLあたりみたいです。
しかしコードを修正せずに手元で完走したのはCMUCLのみ。どうもテストコードにも若干のバグがあります。
実行は、tests.lispを読み込ませるか、シェルからmakeを実行します。

$ make sbcl

 実行結果は、処理系の名前のディレクトリの中に出力されます。
下記は実行結果のsbcl/alltest.ergの例ですが、32bit決め打ちだったり、それはANSI Common Lispの仕様ではないのではというものも結構あります。

Bugid: :ALLTEST-LEGACY-77 interpreted Form: LAMBDA-LIST-KEYWORDS
Should be: (&OPTIONAL &REST &KEY &AUX &BODY &WHOLE &ALLOW-OTHER-KEYS &ENVIRONMENT)
SBCL: (&ALLOW-OTHER-KEYS &AUX &BODY &ENVIRONMENT &KEY SB-INT:&MORE &OPTIONAL &REST &WHOLE)
Why : ""

Bugid: :ALLTEST-LEGACY-87 interpreted Form: (LET ((S (PRIN1-TO-STRING LAMBDA-PARAMETERS-LIMIT))) (OR (EQUAL S "536870911"))) Should be: T SBCL: NIL Why : ""

Bugid: :ALLTEST-LEGACY-391 interpreted Form: (FUNCTIONP (QUOTE ATOM)) Should be: T SBCL: NIL Why : ""

Bugid: :ALLTEST-LEGACY-708 interpreted Form: (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2)) Should be: "doc 2" SBCL: NIL Why : ""

Bugid: :ALLTEST-LEGACY-717 interpreted Form: (DOCUMENTATION (QUOTE BEISPIEL) (QUOTE TYP2)) Should be: "doc 3" SBCL: NIL Why : ""

Bugid: :ALLTEST-LEGACY-1576 interpreted Form: (LET ((S (PRIN1-TO-STRING MOST-POSITIVE-FIXNUM))) (OR (EQUAL S "536870911"))) Should be: T SBCL: NIL Why : "" ....

まとめ

 今回は、CLOCC: ansi-testsを紹介してみました。
色々書きましたが、実行結果を眺めていたらSBCL 1.2.5のバグを見付けてしまったりしたので、こういうテストはやっぱり有用だなと思った次第です。

quickprojectの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の315日目です。

quickprojectとはなにか

 quickprojectは、Zach Beane氏作の雛形からASDFで読み込めるようなCommon Lispのプロジェクトを作成してくれるユーティリティです。

パッケージ情報

パッケージ名quickproject
Quicklisp
Quickdocsquickproject | Quickdocs
CL Test Grid: ビルド状況quickproject | CL Test Grid

インストール方法

(ql:quickload :quickproject)

試してみる

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

 一番単純な使い方は、

(quickproject:make-project "/tmp/bar")

のようなものですが、実行すると、/tmpの下にbarディレクトリが作成され、

README.TXT
This is the stub README.txt for the "bar" project.
bar.asd
;;;; bar.asd

(asdf:defsystem #:bar
  :description "Describe bar here"
  :author "Your Name <your.name@example.com>"
  :license "Specify license here"
  :serial t
  :components ((:file "package")
               (:file "bar")))

bar.lisp
;;;; bar.lisp

(in-package #:bar)

;;; "bar" goes here. Hacks and glory await!

package.lisp
;;;; package.lisp

(defpackage #:bar
  (:use #:cl))

のようなファイルが生成されます。
ASDFの依存関係は、make-projectに:depends-on '(...)という風にリストを渡すとdefsystemの:depends-onが埋められます。

テンプレートを足したりカスタマイズしたい場合

 生成されるテンプレートを足したい場合は、quickproject:*template-directory*以下に雛形のファイルを作って設置すれば、同名のファイルが生成されるようになります。
また、html-templateの機能を使ってパラメータを置換することが可能です。
(#| tmpl_var パラメータ名 |#) という形式で置換できますが、この書式はhtml-templateの書式になります。

~/quickproject-template/LICENSE.txt
License: (#| tmpl_var license |#)

のようなものを作成して、

(quickproject:make-project "/tmp/baz" :template-directory "/mc/quickproject-template/"
                                      :template-parameters '(:NAME "baz"
                                                             :LICENSE "Public domain"
                                                             :AUTHOR "g000001 <g000001@example.com>"))

とすれば、

LICENSE.txt
License: Public domain

のようなものが追加されます。
:template-directoryと:template-parametersについては、quickproject:*template-directory*と、quickproject:*template-parameter-functions*で設定可能ですが、quickproject:*template-parameter-functions*にplistを返す関数を入れるというのが若干ややこしいです。

まとめ

 今回は、quickprojectを紹介してみました。
書き捨てのものでも気軽にプロジェクトを作成できるので重宝しています。

snow2の紹介

Posted 2014-11-09 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の314日目です。

snow2とはなにか

 snow2は、Seth Alves作の今や更新されなくなって久しいSnow(Scheme Now!)を参考にしたR7RSポータブルなパッケージマネージャーです。

パッケージ情報

パッケージ名snow2
プロジェクトサイトsethalves/snow2-client · GitHub

インストール方法

 上記プロジェクトのリポジトリからチェックアウトしてきてインストールします。
Sagittariusを例にすると、

$ make SCHEME=sagittarius install

でツールがインストールされます。

試してみる

 対応しているという処理系は、現在のところ、Chibi、Chicken、Foment、Gauche、Sagittariusとのことです。
よくあるパッケージマネージャーと同じような操作感ですが用意されているコマンドはこんな感じです。

$ snow2 -h
/usr/bin/X11/snow2 [arguments] <operation> '(library name)' ...
  <operation> can be one of: install uninstall list-depends search
  -r --repo <url>      Add to list of snow2 repositories.
  -s --symlink         Make symlinks to a repo's source files.
  -t --test            Install code needed to run tests.
  -v --verbose         Print more.
  -h --help            Print usage message.

Example: snow2 install '(snow hello)'

see https://github.com/sethalves/snow2-client#snow2-client

 試しに(snow hello)をインストールして、ライブラリをimportしてみます。
なお、ダウンロードされたライブラリは、snow2-clientのソースディレクトリに展開されるようですが、拡張子がsldなのでsldの拡張子を扱うように処理系に指示する必要があります。
この辺りのオプションは処理系毎に調べるのが面倒ですが、snow2-clientのクライアントのソースが参考になるかなと思います。)

$ snow2 install '(snow hello)'
$ sash -Lsnow2-client -S.sld
sash> (import (snow hello))
let it snow
314159265358979
#<unspecified>
sash> 

同様にGaucheだとこんな感じ。

gosh -r7 -Isnow2-client -e '(append! *load-suffixes* (list ".sld"))'
gosh[r7rs.user]> (import (snow hello))
let it snow
314159265358979
#<undef>
gosh[r7rs.user]> 

まとめ

 今回は、snow2を紹介してみました。
現状ドキュメントが少ないので各々の処理系が提供するパッケージマネージャーより使い勝手が良くはない感じですが、ポータブルなパッケージマネージャーとしてメジャーになると良いですね。

defsystem-compatibilityの紹介

Posted 2014-11-08 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の313日目です。

defsystem-compatibilityとはなにか

 defsystem-compatibilityは、Gary Warren King氏作の各種defsystemを統一的に扱うためのコンパチライブラリです。

パッケージ情報

パッケージ名defsystem-compatibility
Quicklisp
CLiKiCLiki: defsystem-compatibility
Quickdocsdefsystem-compatibility | Quickdocs
CL Test Grid: ビルド状況defsystem-compatibility | CL Test Grid

インストール方法

(ql:quickload :defsystem-compatibility)

試してみる

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

 defsystemは1980年前後のMIT CADRから現在のasdf:defsystemと同じようなものが存在しますが、Common Lispには取り入れられませんでした。
Kent Pitman氏がANSI Common Lispに提案したりはしていたみたいですが、これも入らず現在に至ります。

 ただ、やはりdefsystemの需要はあったので、処理系が各々実装したり、コミュニティで提案/実装されたりしていました。
各種defsystemは大まかなところは源流のLispマシンのdefsystemと同じではあるのですが、それぞれ微妙に違っています。

 現在主流のものはasdf:defsystemですが、90年代ではMark Kantrowitz氏のmk:defsystemが良く使われていました。
また、Allegro CLやLispWorksも独自のdefsystemを持っていますが、IDE等ではこっちのサポートの方が手厚かったりはします。

 ということで、この辺りの各種systemを統一的に扱おうというのが、defsystem-compatibilityです。
現在のところ下記のようなものが定義されています。しかし、残念ながら現在のところASDFのサポートのみとのこと。

  • system-loaded-p
  • associated-test-system
  • available-systems
  • loaded-systems
  • ensure-system-name
  • filename-looks-like-system-file-p
  • system-dependencies
  • collect-system-files
  • system-source-file
  • map-system-files
  • map-system-dependencies
  • find-system
  • system-name
  • collect-system-dependencies
  • system-source-directory
  • system-signature
  • registered-systems
  • system-relative-pathname
  • system-property
  • system-sub-systems
  • system-name-for-display
  • pathname-name+type
  • top-level-system-p
  • pathname-for-system-file

動作は、一部ですが、こんな感じです。

(dsc:map-system-files :cl-ppcre #'print)
;>>  
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/packages.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/specials.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/util.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/errors.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/charset.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/charmap.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/chartest.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/lexer.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/parser.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/regex-class.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/regex-class-util.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/convert.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/optimize.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/closures.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/repetition-closures.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/scanner.lisp" 
;>>  "/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/api.lisp" 
;=>  NIL

(dsc:system-source-directory (dsc:find-system :cl-ppcre)) ;=> #P"/quicklisp/dists/quicklisp/software/cl-ppcre-2.0.7/"

(dsc:available-systems) ;=> ("quicklisp")

(dsc:filename-looks-like-system-file-p "foo.asd") ;=> T

(dsc:filename-looks-like-system-file-p "foo.system") ;=> NIL

まとめ

 今回は、defsystem-compatibilityを紹介してみました。
20年前位のコードだとmk:defsystemでまとめられていることが結構多いのですが、この辺りをasdfと一緒に扱えると書き換えなくて良いので個人的には非常に嬉しいです。
今後に期待したいところですが、しかし、どうも開発は停止している様子。

cl-matchの紹介

Posted 2014-11-07 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の312日目です。

cl-matchとはなにか

 cl-matchは、Daniel S. Bensen氏作のML風のパタンマッチのライブラリです。現在は、Tony Garnock-Jones氏がメンテナンスをしているようです。

パッケージ情報

パッケージ名cl-match
Quicklisp
CLiKiCLiki: cl-match
Quickdocscl-match | Quickdocs
common-lisp.netcl-match
CL Test Grid: ビルド状況cl-match | CL Test Grid

インストール方法

(ql:quickload :cl-match)

試してみる

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

 READMEにいきなり、

================================================================================
================================================================================
NOTE: SUPERSEDED BY OPTIMA, https://github.com/m2ym/optima.
================================================================================
================================================================================

とあるのですが、これはオリジナルにはないのでメンテナの人が付けたものでしょうか。
どういう経緯なのか不明ですが、なんだか微妙です(オリジナルの作者は承知の上なのか)。

 それはさておき中身ですが、match、ifmatch、letmatch、defpattern位でシンプルです。
matchが汎用で多分岐のもの、ifmatchは、2分岐、letmatchは、ifmatchに近いですが、マッチしなければエラー、defpatternでパタンに名前が付けられます。
パタンにはガードを付けることが可能で:whenで指定します。

(cl-match:ifmatch (:list a b (:list c)) '(a 1 (2))
  (list b c)
  :fail)
;=>  (1 2)

(cl-match:ifmatch (:when (and (numberp b) (numberp c)) (:list a b (:list c))) '(a 1 (2)) (list b c) :fail) ;=> (1 2)

(cl-match:ifmatch (:when (and (numberp b) (numberp c)) (:list a b (:list c))) '(a b (c)) (list b c) :fail) ;=> :FAIL

(cl-match:letmatch (:when (and (numberp b) (numberp c)) (:list a b (:list c))) '(a 1 (2)) (list b c)) ;=> (1 2)

(cl-match:match '(+ 1 2) ((:when (and (numberp M) (numberp N)) (:list '+ M N)) (+ M N)) ((:when (and (numberp M) (numberp N)) (:list '* M N)) (* M N))) ;=> 3

(cl-match:defpattern mypat (a b c) `(:when (and (numberp ,b) (numberp ,c)) (:list ,a b (:list c))))

(cl-match:match '(a 1 (2)) ((mypat a b c) (list a b c))) ;=> (A 1 2)

まとめ

 今回は、cl-matchを紹介してみました。
件の移行勧告は時期的にConsolidating Common Lisp Librariesという働き掛けが発端なのかなと思います。2年経過してこの働き掛け自体忘れられつつある感がありますが、実際のところどうなんでしょう。
ちなみに、cl-matchの性能は以前にベンチを取ってみたことがありますが、特に悪いという訳でもありません(遅くてもoptimaの倍位)。

 仮に競合する5つのライブラリがあったとして1本に絞ったは良いがその選ばれた1本がメンテナンスされなくなったら、一体どうなるのかなと思うことはあります。
現状のCommon Lispのライブラリを眺める限りでは、質が良くても作者の都合で放棄されることが多いですが、こっちの方がどうにか改善されて欲しいですね。

YTools: outの紹介

Posted 2014-11-06 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の311日目です。

YTools: outとはなにか

 YTools: outは、Drew McDermott氏のユーティリティであるYtoolsの中の出力系のユーティリティです。

パッケージ情報

パッケージ名YTools: out
Quicklisp×
プロジェクトページHome page for Drew McDermott
CLiKiCLiki: YTools

インストール方法

 上記プロジェクトページからダウンロードしてきて適当に導入します。

試してみる

 YToolsは、1976年からMcDermott氏がまとめてきたLispのユーティリティ集です。YToolsには詳細な50ページのマニュアルがあるので詳しくはそちらを参照してください。
outについては、formatと比較した文献もあります。

 最も基本的な使い方としては、outに文字列を与えれば*standard-output*に出力します。

(out "x")
;>>  x
;=>  <no values>

 ストリームの指定を省略すると*standard-output*ですが、:toでストリームを指定することもできます。また、formatと同じくnilで文字列を生成するようです。

(with-output-to-string (o)
  (out (:to o) "x"))
;=>  "x"

 改行は、:%で、数字は数値分の空白を出力します

(out 10 "x" :% 9 "x" :% 8 "x")
;>>            x
;>>           x
;>>          x
;=>  <no values>

 :eで節を作ることが可能で、この節の中では、:oで囲んだ式を出力します。繰り返し等で使えます。

(out "start" :%
     (:e (repeat :for ((_ = 1 :to 10))
           (:o "foo"))) :%
     "end" :%)
;>>  start
;>>  foofoofoofoofoofoofoofoofoofoo
;>>  end
;>>  
;=>  <no values>

適当な利用例

(defun join (strings sep)
  (out (:to nil)
       (:e (repeat :for ((e :in strings :tail etail))
             (:o (:a e)
                 (:q ((cdr etail)
                      (:a sep))))))))

(join '("a" "b" "c") "-") ;=> "a-b-c"

out vs format
(format t "~{~V@{~A~:*~}:~:*~A~*~%~}" '(13 = 5 \# 22 % 18 + 40 % 2 *))
;>>  =============:13
;>>  #####:5
;>>  %%%%%%%%%%%%%%%%%%%%%%:22
;>>  ++++++++++++++++++:18
;>>  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%:40
;>>  **:2
;>>  
;=>  NIL

(out (:e (loop :for (times pat . _) :on '(13 = 5 \# 22 % 18 + 40 % 2 *) :by #'cddr :do (dotimes (i times) (:o (:a pat))) (:o ":" times :%)))) ;>> =============:13 ;>> #####:5 ;>> %%%%%%%%%%%%%%%%%%%%%%:22 ;>> ++++++++++++++++++:18 ;>> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%:40 ;>> **:2 ;>> ;=> <no values>

;;; YToolsのrepeatと組み合わせてみた例 (out (:e (repeat :for ((x = '(13 = 5 \# 22 % 18 + 40 % 2 *) :then (cddr x))) :while x (match-let (?times ?pat . ?_) x (dotimes (i times) (:o (:a pat))) (:o ":" times :%))))) ;>> =============:13 ;>> #####:5 ;>> %%%%%%%%%%%%%%%%%%%%%%:22 ;>> ++++++++++++++++++:18 ;>> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%:40 ;>> **:2 ;>> ;=> <no values>

まとめ

 今回は、YTools: outを紹介してみました。
YToolsのユーティリティを使って描くと、なんとなく独特の雰囲気が出ますが、1970年代後半から1980年代にかけてはこういう見た目のコードが結構多い気もします。

ScmObjの紹介

Posted 2014-11-05 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の310日目です。

ScmObjとはなにか

 ScmObjは、Dorai Sitaram氏作のCLOS風のSchemeのオブジェクト指向システムです。

パッケージ情報

パッケージ名ScmObj
プロジェクトサイト ScmObj: An Object System for Scheme

インストール方法

 プロジェクトサイトからダウンロードしてきてScheme処理系に読み込ませます。
動作にはslibが必要とあります。

試してみる

 slibが必要ということで、試してみた処理系はGaucheです(slibはGaucheでもオプションですが)。
とはいえslibに依存しているところはそんなに多くはないようなのでslib無しでの移植も難しくはない気がします。
使い方については、プロジェクトサイトに詳しいですが、多重継承、多重メソッド、:before、:after、:aroundのメソッド結合ありなCLOS風のオブジェクト指向システムです。但しMOPはありません。

 ということで、毎度お馴染BankAccountを書いてみます。

(define <bank-account>
  (make-class () (:dollars)))

(define dollars (make-generic-procedure a))

(defmethod dollars ((a <bank-account>)) (slot-value a :dollars))

(define set-dollars (make-generic-procedure a val))

(defmethod set-dollars ((a <bank-account>) (val #t)) (set-slot-value a :dollars val))

(define deposit (make-generic-procedure a n))

(defmethod deposit ((a <bank-account>) (n #t)) (set-dollars a (+ n (dollars a))) (dollars a))

(define withdraw (make-generic-procedure a n))

(defmethod withdraw ((a <bank-account>) (n #t)) (set-dollars a (max 0 (- (dollars a) n))) (dollars a))

(define *my-account* (make-instance <bank-account> :dollars 200))

(dollars *my-account*) ;=> 200

(deposit *my-account* 50) ;=> 250

(withdraw *my-account* 100) ;=> 150

(withdraw *my-account* 200) ;=> 0

(define <stock-account> (make-class (<bank-account>) (:num-shares :price-per-share)))

(define num-shares (make-generic-procedure a))

(defmethod num-shares ((a <stock-account>)) (slot-value a :num-shares))

(define price-per-share (make-generic-procedure a))

(defmethod price-per-share ((a <stock-account>)) (slot-value a :price-per-share))

(defmethod dollars ((a <stock-account>)) (* (num-shares a) (price-per-share a)))

(defmethod set-dollars ((a <stock-account>) (n #t)) (set-slot-value a :num-shares (/ n (price-per-share a))) (dollars a))

(define *my-stock* (make-instance <stock-account> :dollars 0 :price-per-share 30 :num-shares 10))

(dollars *my-stock*) ;=> 300

(set-dollars *my-stock* 600) ;=> 600

(deposit *my-stock* 60) ;=> 660

(num-shares *my-stock*) ;=> 22

(withdraw *my-stock* 120) ;=> 540

(num-shares *my-stock*) ;=> 18

 クラスのスロット定義はスロット名のみなのでアクセサは自前で定義。
メソッド定義時に総称関数が自動で作成されることもないので明示的に定義。
スロットのデフォルト値もないということで、インスタンス生成時に指定。
という感じです。

 メソッド結合があるということなので、<stock-account>のdepositを実際のスロットにアクセスするように書き直してみます。

(define <stock-account>
  (make-class (<bank-account>)
    (:num-shares :price-per-share)))

(define num-shares (make-generic-procedure a))

(defmethod num-shares ((a <stock-account>)) (slot-value a :num-shares))

(define price-per-share (make-generic-procedure a))

(defmethod price-per-share ((a <stock-account>)) (slot-value a :price-per-share))

(defmethod dollars :before ((a <stock-account>)) (set-slot-value a :dollars (* (num-shares a) (price-per-share a))))

(defmethod set-dollars ((a <stock-account>) (n #t)) (set-slot-value a :num-shares (/ n (price-per-share a))) (dollars a))

(define *my-stock* (make-instance <stock-account> :dollars 0 :price-per-share 30 :num-shares 10))

(dollars *my-stock*) ;=> 300

(set-dollars *my-stock* 600) ;=> 600

(deposit *my-stock* 60) ;=> 660

(num-shares *my-stock*) ;=> 22

(withdraw *my-stock* 120) ;=> 540

(num-shares *my-stock*) ;=> 18

dollarsスロットをアクセスする前に計算を:beforeメソッドで済ませます。どっちかというと、元の書法よりこっちの方が素直な気も。

まとめ

 今回は、ScmObjを紹介してみました。
現在のChickenのメインのオブジェクト指向システムはcoopsですが、ScmObjをベースにしたものとのこと。
これ位の機能があれば大体間に合いそうです。

eggs: patchの紹介

Posted 2014-11-04 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の309日目です。

eggs: patchとはなにか

 eggs: patchは、Tony Sidaway氏作のUnixのdiffの結果を読み込んでS式のパッチを作ったり適用したりするユーティリティです。

パッケージ情報

パッケージ名eggs: patch
Chicken eggs:patch - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install patch

すれば、

(use patch)

で使えます。

試してみる

 マニュアルを眺めてみるとどうもScheme処理系の中から使うというよりスクリプトで使うことを想定しているようです。
S式のパッチの形式は、

([c|a|d] start-line finish-line new-start-line new-finish-line (lines to be deleted) (lines to be inserted))

というリストです。

a.txt
foo
bar
baz
quux
b.txt
foo
BAR
BAZ
quux

というファイルがあった場合、

(use patch)
(use shell)

(with-input-from-string (capture "diff /tmp/a.lisp /tmp/b.lisp") make-patch) ;=> ((c 2 3 2 3 ("bar" "baz") ("BAR" "BAZ")))

こんな感じの出力になります。

#!/usr/bin/env csi

(use patch)

(apply-patch '((c 2 3 2 3 ("bar" "baz") ("BAR" "BAZ"))))

のようなfoo.scmというスクリプトを作れば

$ cat a.txt|./foo.scm
foo
BAR
BAZ
quux

のようにパッチを適用することが可能です。reverse-patchは逆に適用します。

まとめ

 今回は、eggs: patchを紹介してみました。
若干紹介しづらいというか微妙なユーティリティでした。

com.informatimago.common-lisp.edの紹介

Posted 2014-11-03 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の308日目です。

com.informatimago.common-lisp.edとはなにか

 com.informatimago.common-lisp.edは、Pascal BourguignonのUNIXのedエディタのCommon Lisp実装です。

パッケージ情報

パッケージ名com.informatimago.common-lisp.ed
Quicklisp

インストール方法

(ql:quickload :com.informatimago.common-lisp.ed)

試してみる

 ed(1)と完全互換ということですが、何故作ろうと思ったのか興味深いです。
動作はそのままed(1)です。

(com.informatimago.common-lisp.ed.ed:ed "/tmp/bar.txt")
CL-USER> a
おはよう日本
おはよう日本
.
w
1,np
     1  おはよう日本
     2  おはよう日本
q
;=> NIL

(*:read-file-to-string "/tmp/bar.txt") ;=> "おはよう日本 ; おはよう日本 ; "

まとめ

 今回は、com.informatimago.common-lisp.edを紹介してみました。
Common LispにはLispマシンからedが受け継がれています。
初見はその辺りの拡張かと思いましたが、まさかedエディタの実装とは思いませんでした。

eggs: shellの紹介

Posted 2014-11-02 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の307日目です。

eggs: shellとはなにか

 eggs: shellは、Chickenからシェルを呼ぶためのライブラリです。

パッケージ情報

パッケージ名eggs: shell
Chicken eggs:shell - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install shell

すれば、

(use shell)

で使えます。

試してみる

 大別すると、実行だけするrunとコマンドが出力した結果を文字列にして返すcaptureがあります。

(run (pwd))
;=> #<unspecified>

(capture ((date -R))) ;=> "Mon, 27 Oct 2014 02:31:31 +0900\n"

 これらのバリエーションという感じで、複数のコマンドの実行結果を多値で返すrun*、実行する関数を返すshellがあります。

(shell (ls -l))
;=> #<procedure (? . args654)>

(run* (pwd) (pwd) (pwd)) ;=> 0 ; 0 ; 0

以上の関数は、executeという関数が下請けになっていてマクロを展開すればexecuteが出てきます。

 コマンドの形式ですが、文字列でもリストのでもOKになっています。リストの方はflattenされるのでネストしていても大丈夫です。

(capture "ls -1a")

(capture (ls (-a -1)))

(capture (ls -a -1))

まとめ

 今回は、eggs: shellを紹介してみました。
シンプルな構成でなかなか良さそうですね。

cl-performance-tuning-helperの紹介

Posted 2014-11-01 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の306日目です。

cl-performance-tuning-helperとはなにか

 cl-performance-tuning-helperは、Shingo SUZUKI氏作のパフォーマンス測定用のユーティリティです。

パッケージ情報

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

インストール方法

(ql:quickload :cl-performance-tuning-helper)

試してみる

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

 定義されているのは、

  • cload
  • performance
  • trash-outputs
  • asmout

の4つです。

 cloadは、compile-file & loadのイディオムを一つにまとめたもの。
asmoutは、disassembleの結果をファイルに書き出します。
performanceは、繰り返し回数を指定しつつ全体にtimeを実行します。

(pth:performance 100 nil (fib 20))
;>> ;;; performance test for FIB 100 times
;>> ;;;   do (FIB 20)
;>> Evaluation took:
;>>   0.013 seconds of real time
;>>   0.012000 seconds of total run time (0.012000 user, 0.000000 system)
;>>   92.31% CPU
;>>   41,794,209 processor cycles
;>>   0 bytes consed
;=> T  

trash-outputsは、いらない出力を捨てるというもの。UNIXでいえば、> /dev/nullという感じです。

 ちなみに現在の実装だと文字列ストリームに出力するようになっていますが、出力を捨てるためのストリームはmake-broadcast-streamで作れるので、こっちを利用した方が効率が良いかなと思ったりしました。

(defmacro trash-outputs (&body body)
  "trash system stream outputs:
*standard-output*,
*error-output*,
and *trace-output*."
  (let ((sos (gensym)))
    `(let* ((,sos (make-string-output-stream))
            (*standard-output* ,sos)
            (*error-output* ,sos)
            (*trace-output* ,sos) )
       ,@body )))

(defmacro trash-outputs/broadcast-stream (&body body) (let ((out (gensym))) `(let* ((,out (make-broadcast-stream)) (*standard-output* ,out) (*error-output* ,out) (*trace-output* ,out)) ,@body)))

 計測するとこんな感じです。

(defvar *s1000* (make-string 1000))

(pth:trash-outputs (dotimes (i (* 1000 1000)) (princ *s1000*))) ;=> NIL #|------------------------------------------------------------| Evaluation took: 1.266 seconds of real time 1.268000 seconds of total run time (0.608000 user, 0.660000 system) [ Run times consist of 0.012 seconds GC time, and 1.256 seconds non-GC time. ] 100.16% CPU 4,167,340,275 processor cycles 4,194,413,440 bytes consed

Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz |------------------------------------------------------------|#

(trash-outputs/broadcast-stream (dotimes (i (* 1000 1000)) (princ *s1000*))) ;=> NIL #|------------------------------------------------------------| Evaluation took: 0.090 seconds of real time 0.092000 seconds of total run time (0.092000 user, 0.000000 system) 102.22% CPU 297,093,468 processor cycles 0 bytes consed

Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz |------------------------------------------------------------|#

まとめ

 今回は、cl-performance-tuning-helperを紹介してみました。
チューニングのユーティリティがまとまっていると便利ですね。

cl-epochの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の304日目です。

cl-epochとはなにか

 cl-epochは、Andrew Pennebaker氏作のCommon LispのUniversal TimeとPosix time(Epoch time)との変換のライブラリです。

パッケージ情報

パッケージ名cl-epoch
Quicklisp
参考サイトThe Common Lisp and Unix epochs
Quickdocscl-epoch | Quickdocs
CL Test Grid: ビルド状況cl-epoch | CL Test Grid

インストール方法

(ql:quickload :cl-epoch)

試してみる

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

 ソースコードにも書いてありますが、Common Lisp TipsのThe Common Lisp and Unix epochsの回のコードそのまんまです。
使い方は、シンプルで3つ関数があるのみです。

(cl-epoch:get-epoch-time)
;=>  1414252610

(cl-epoch:universal->unix-time (encode-universal-time 0 0 0 1 1 1970 0)) ;=> 0

(cl-epoch:unix->universal-time (cl-epoch:get-epoch-time)) ;=> 3623241412

まとめ

 今回は、cl-epochを紹介してみました。
一発物で、しかもブログのコードを第三者がQuicklispにまとめただけという物ですが、example.lispにサンプルコードが用意されている辺り好感が持てます。

clapの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の303日目です。

clapとはなにか

 clapは、Ryohei Ueda氏によるPythonの標準ライブラリをCommon Lispに実現しようというプロジェクトです。

パッケージ情報

パッケージ名clap
Quicklisp×
プロジェクトサイトgaraemon/clap · GitHub

インストール方法

 上記のプロジェクトサイトからチェックアウトしてきてQuicklispのlocal-projectsに置けば

(ql:quickload :clap)

可能です。

試してみる

 2010年末に始まったプロジェクトですが、3年位前から動きが停滞しています。
現在実装されているところとしては、

  • pwd
  • argparse
  • sys
  • os
  • hashlib
  • string
  • builtin

 あたりで

  • clap-pwd
  • clap-argparse
  • clap-sys
  • clap-os
  • clap-hashlib
  • clap-string
  • clap-builtin

が上記に相当します。

 少し紹介してみると、

(clap-builtin:whitespacep #\Space)
;=>  #\ 

(clap-os:getenv "LANG") ;=> "ja_JP.UTF-8"

(clap-hashlib:hexdigest (clap-hashlib:md5 "foo")) ;=> "acbd18db4cc2f85cedef654fccc4a4d8"

(clap-builtin:dict '(("greets" . "おはよう")) :test #'equal) ;=> #<HASH-TABLE :TEST EQUAL :COUNT 1 {102EE3E613}>

(clap-string:substitute (clap-string:make-template "$greets日本") (clap-builtin:dict '(("greets" . "おはよう")) :test #'equal)) ;=> "おはよう日本"

みたいなところです。

まとめ

 今回は、clapを紹介してみました。
以前丸ごとQuicklispに申請された時には、まだ発展途上ということで登録は却下されましたが、今なら大分ゆるくなってきたので登録されるかもしれません。もしくはサブモジュールごとに登録というのもありかもしれません。

Hierarchical Packagesの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の302日目です。

Hierarchical Packagesとはなにか

 Hierarchical Packagesは、Allegro CLとCMUCLでサポートされている、パッケージを階層分けする仕組みです。

パッケージ情報

パッケージ名Hierarchical Packages
Quicklisp×
参考サイトAllegro CL: Packages
CMUCL: Hierarchical Packages

インストール方法

 上記のAllegro CLのドキュメントに参照実装がありますので適当に動かします。
SBCLに移植してみたものがありますので良かったらどうぞ。find-packageを上書きするので注意してください。

 Quicklispのlocal-projects以下に配置すれば、

(ql:quickload :relative-package-names)

で読み込めます。

試してみる

階層的なパッケージとありますが、階層を「.」で区切るという命名規約と、パッケージの相対位置を指定できるようにするrelative-package-namesの2つから成り立っています。
CMUCLでは、18dからAllegro CLの実装を取り入れたようです。
Allegro CL、CMUCL共に起動時のデフォルトで有効になっていて、*features*に:relative-package-namesが入っています。
relative-package-namesの例としては、

;; utilities
(defun children-names (pkg)
  (nreverse
   (maplist (lambda (cdr)
              (format nil "~{~A~^.~}" (reverse cdr)))
            (nreverse (*:split "\\." (string pkg))))))

(defmacro defpackage/parents (name &body options) (let ((pkgs (children-names name))) `(list ,@(mapcar (lambda (p) (eval-when (:compile-toplevel :load-toplevel :execute) `(or (find-package ,p) (defpackage ,p ,@options)))) pkgs))))

(cl:in-package :cl-user) 

(defpackage/parents :a.b.c.d (:use :cl))

(defpackage/parents :a.b.cc.dd (:use :cl))

(cl:in-package :a.b.c.d)

(defun foo (n) (list :a.b.c.d n))

(cl:in-package :a.b.c)

(defun foo (n) (list :a.b.c (a.b.c.d::foo n)))

(defun bar (x) (list :a.b.c x))

(cl:in-package :a.b.c.d)

(defun bar (x) (list :a.b.c.d (a.b.c::bar x)))

(cl:in-package :a.b.cc.dd)

(defun bar (x) (list :a.b.cc.dd (a.b.c::bar x)))

;;; *EOF*

のようなものが、

(cl:in-package :cl-user) 

(defpackage/parents :a.b.c.d (:use :cl))

(defpackage/parents :a.b.cc.dd (:use :cl))

(cl:in-package :a.b.c.d)

(defun foo (n) (list :a.b.c.d n))

(cl:in-package :..)

(defun foo (n) (list :a.b.c (.d::foo n)))

(defun bar (x) (list :a.b.c x))

(cl:in-package :.d)

(defun bar (x) (list :a.b.c.d (..::bar x)))

(cl:in-package :...cc.dd)

(defun bar (x) (list :a.b.cc.dd (...c::bar x)))

;;; *EOF*

のように書けます。

 なんとなくですが、親子階層シンボルへの参照は便利そう、しかしin-packageで相対指定するとカオスなことになりそう、という印象です。
まだ、使いこんでいないのでどの辺りが便利なのかが実感できていないですが、第一印象としては、あまり便利そうでもないかなというところです。

まとめ

 今回は、Hierarchical Packagesを紹介してみました。
Common Lispの前身のZetalisp(Lisp machine Lisp)のパッケージは階層パッケージでしたが、Zetalispを参考にしつつもCommon Lispは階層パッケージにはなりませんでした。
そのうちZetalispの階層パッケージとも比較してみたいところです。

com.informatimago.common-lisp.pictureの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の301日目です。

com.informatimago.common-lisp.pictureとはなにか

 com.informatimago.common-lisp.pictureは、Pascal Bourguignon氏作の主にコンスセルのアスキーアートの描画機能を持つアスキーアートのライブラリです。

パッケージ情報

パッケージ名com.informatimago.common-lisp.picture
Quicklisp

インストール方法

(ql:quickload :com.informatimago.common-lisp.picture)

で対象のライブラリのみ。または、

(ql:quickload :com.informatimago.common-lisp)

で他のライブラリも一緒に読み込めます。

試してみる

 comp.lang.lispでは色々な質問の回答者としてお馴染のPascal Bourguignon氏ですが、com.informatimago.common-lispというライブラリ集を作っていて、様々なものが収められています。
今回紹介するcom.informatimago.common-lisp.pictureは2つのパッケージから構成されていますが、picutureの方は汎用のアスキーアートのライブラリで、cons-to-asciiはコンスセルのアスキーアートを作成するライブラリです。

(defvar *tree* '(-9 (-2 (9 10))))
*tree*
;=>  (-9 (-2 (9 10)))

(use-package '(:com.informatimago.common-lisp.picture.cons-to-ascii :com.informatimago.common-lisp.picture.picture))

(draw-list *tree*) ;=> +-----------------------------------------------+ ; | (-9 (-2 (9 10))) | ; | | ; | +---+---+ +---+---+ | ; | | * | * |-->| * |NIL| | ; | +---+---+ +---+---+ | ; | | | | ; | v v | ; | +----+ +---+---+ +---+---+ | ; | | -9 | | * | * |-->| * |NIL| | ; | +----+ +---+---+ +---+---+ | ; | | | | ; | v v | ; | +----+ +---+---+ +---+---+ | ; | | -2 | | * | * |-->| * |NIL| | ; | +----+ +---+---+ +---+---+ | ; | | | | ; | v v | ; | +---+ +----+ | ; | | 9 | | 10 | | ; | +---+ +----+ | ; +-----------------------------------------------+ ;

(let ((p (frame-rect (make-instance 'picture :width 72 :height 30 :background ".") 0 0 74 30))) (draw-cell p 2 25 *tree*)) ;=> +----------------------------------------------------------------------- ; |....................................................................... ; |....................................................................... ; |....................................................................... ; |.+---+---+...+---+---+................................................. ; |.| * | * |-->| * |NIL|................................................. ; |.+---+---+...+---+---+................................................. ; |...|...........|....................................................... ; |...v...........v....................................................... ; |.+----+......+---+---+...+---+---+..................................... ; |.|.-9.|......| * | * |-->| * |NIL|..................................... ; |.+----+......+---+---+...+---+---+..................................... ; |...............|...........|........................................... ; |...............v...........v........................................... ; |.............+----+......+---+---+...+---+---+......................... ; |.............|.-2.|......| * | * |-->| * |NIL|......................... ; |.............+----+......+---+---+...+---+---+......................... ; |...........................|...........|............................... ; |...........................v...........v............................... ; |.........................+---+.......+----+............................ ; |.........................|.9.|.......|.10.|............................ ; |.........................+---+.......+----+............................ ; |....................................................................... ; |....................................................................... ; |....................................................................... ; |....................................................................... ; |....................................................................... ; |....................................................................... ; |....................................................................... ; +----------------------------------------------------------------------- ;

(let ((p (frame-rect (make-instance 'picture :width 35 :height 20 :background ".") 0 0 80 30))) (draw-string p 0 0 "0") (draw-string p 10 0 "10") (draw-string p 20 0 "20") (draw-string p 30 0 "30") (draw-line p 0 0 10 10) (draw-line p 10 10 10 -5) (draw-line p 20 5 10 10) (draw-line p 30 15 10 -10) (draw-arrow p 23 15 5 0)) ;=> |.................................. ; |.................................. ; |.................................. ; |.................................. ; |......................----->.*.... ; |............................*.*... ; |...........................*...*.. ; |..........................*.....*. ; |.........................*.......* ; |.........**.............*......... ; |........*..**..........*.......... ; |.......*.....**.......*........... ; |......*........**....*............ ; |.....*...........**.*............. ; |....*..............*.............. ; |...*.............................. ; |..*............................... ; |.*................................ ; |*................................. ; *---------10--------20--------30--- ;

まとめ

 今回は、com.informatimago.common-lisp.pictureを紹介してみました。
Pascal Bourguignon氏は面白いものを沢山作っていますので、どんどん紹介していきたいと思っています。

draw-cons-treeの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の300日目です。

draw-cons-treeとはなにか

 draw-cons-treeは、コンスのツリーをアスキーアートで表示するものです。Nils M. Holm氏がSchemeで作成したものをChris Bagley氏がCommon Lispに移植したものとのこと。

パッケージ情報

パッケージ名draw-cons-tree
Quicklisp
Quickdocsdraw-cons-tree | Quickdocs
CL Test Grid: ビルド状況draw-cons-tree | CL Test Grid

インストール方法

(ql:quickload :draw-cons-tree)

試してみる

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

 エクスポートされている定義は、draw-cons-treeのみです。

(defvar *tree* (funcall (5am:gen-tree :size 5)))

*tree* ;=> (-9 (-2 (9 10)))

(draw-cons-tree:draw-tree *tree*) ;>> [o|o]---[o|/] ;>> | | ;>> -9 [o|o]---[o|/] ;>> | | ;>> -2 [o|o]---[o|/] ;>> | | ;>> 9 10 ;>> ;=> NIL

こんな感じにコンスセルの木がアスキーアートになります。

まとめ

 今回は、draw-cons-treeを紹介してみました。
コンパクトな表示でなかなか良いですね。

emacs Lisp: nadviceの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の299日目です。

emacs Lisp: nadviceとはなにか

 emacs Lisp: nadviceは、

パッケージ情報

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

インストール方法

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

試してみる

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

before/after/around以外の仲間達

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

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

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

(defun foo (n) n)

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

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

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

(advice-remove 'foo #'zerop)

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

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

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

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

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

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

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

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

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

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

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

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

(foo 1) ;=> 2

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

(bar 1 2 3) ;=> 3

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

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

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

まとめ

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

cl-difflibの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の297日目です。

cl-difflibとはなにか

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

パッケージ情報

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

インストール方法

(ql:quickload :cl-difflib)

試してみる

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

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

に対応するのは、大体

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

位でしょうか。

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

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

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

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

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

使い方も大体同じです。

まとめ

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

cl-qprintの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の296日目です。

cl-qprintとはなにか

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

パッケージ情報

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

インストール方法

(ql:quickload :cl-qprint)

試してみる

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

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

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

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

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

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

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

まとめ

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

cl-cronの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の295日目です。

cl-cronとはなにか

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

パッケージ情報

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

インストール方法

(ql:quickload :cl-cron)

試してみる

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

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

(cron:start-cron)

(cron:stop-cron)

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

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

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

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

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

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

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

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

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

;;; *EOF*

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

まとめ

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

glintの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の294日目です。

glintとはなにか

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

パッケージ情報

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

インストール方法

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

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

試してみる

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

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

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

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

(if 1 2 3 4)

(define)

(let () a)

(if (= car x 0) a b)

(define morlis (lambda (x) x))

(define (morlis y) y)

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

のようなものだと、

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

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

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

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

まとめ

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

Lucid CL: Adviceの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の293日目です。

Lucid CL: Adviceとはなにか

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

パッケージ情報

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

インストール方法

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

試してみる

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

まとめ

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

Clozure CL: Watched Objectsの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の292日目です。

Clozure CL: Watched Objectsとはなにか

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

パッケージ情報

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

インストール方法

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

試してみる

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

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

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

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

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

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

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

(watch *h*)

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

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

*L* ;=> (CAR CADR CADDR)

(watch *L*)

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

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

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

*L* ;=> (CAR 1 CADDR)

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

(unwatch *L*)

まとめ

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

srfi 96の紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の291日目です。

srfi 96とはなにか

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

パッケージ情報

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

試してみる

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

(require 'srfi-96)

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

(scheme-implementation-type)
;=> larceny

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

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

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

t ;=> #t

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

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

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

まとめ

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

scribbleの紹介

Posted 2014-10-17 10:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の290日目です。

scribbleとはなにか

 scribbleは、Fare Rideau氏作のCommon LispでScribble記法を利用できるようにするライブラリです。

パッケージ情報

パッケージ名scribble
Quicklisp
CLiKiCLiki: Scribble
Quickdocsscribble | Quickdocs
CL Test Grid: ビルド状況scribble | CL Test Grid

インストール方法

(ql:quickload :scribble)

試してみる

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

 Racket(PLT Scheme)方面では、Eli Barzilay氏考案のScribbleという記法が良く使われるようです。
Scheme処理系に付属のマニュアル等でたまに使われているのを見掛けることもありますね。

@{文章はどういう風に書くんでしょうか}

@code{(defun hello (x) (princ "Hello, ") (princ x) (terpri))}

@code{(hello "foo bar baz")}

@example{(+ 1 2) -> @(+ 1 2)⏎}

@foo|--{bar}@|{baz}--|

こんな感じに書いたものが、

(let ((p "/tmp/foo.txt")
      (eof '#:eof)
      (*readtable* (copy-readtable nil)))
  (scribble:enable-scribble-at-syntax)
  (with-open-file (s p :direction :input :if-does-not-exist :error)
    (loop for i = (read s nil eof nil)
          until (eq i eof)
          collect i)))
;=>  (("文章はどういう風に書くんでしょうか")
;     (CODE "(defun hello (x)" "
;    "
;      "(princ \"Hello, \")" "
;    "
;      "(princ x)" "
;    "
;      "(terpri))")
;     (CODE "(hello \"foo bar baz\")") (EXAMPLE "(+ 1 2) -> " (+ 1 2) "⏎")
;     (FOO "bar}@|{baz"))

こんな感じに読まれます。

まとめ

 今回は、scribbleを紹介してみました。
コード例を沢山記述しつつホスト言語の機能を活用したい場合などには便利そうな記法ですね。

cl-jpl-utilの紹介

Posted 2014-10-16 11:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の289日目です。

cl-jpl-utilとはなにか

 cl-jpl-utilは、J.P. Larocque氏作のCommon Lispのユーティリティ集です。

パッケージ情報

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

インストール方法

(ql:quickload :jpl-util)

試してみる

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

 JPLとあるのでNasaのJPLかなにかと思いましたが、J.P. Larocque氏のイニシャルということみたいです。
内容は良くあるユーティリティ集ですが、こざっぱりとした感じに纏まっています。

関数

  • 1or
  • a/an-number
  • accumulate-to-dynamic-vector
  • accumulate-to-hash-table
  • accumulate-to-list
  • accumulate-to-vector
  • adjacent-pairs
  • alist->hash-table
  • alist->plist
  • all
  • any
  • assoc*
  • best
  • check-bounding-indices
  • check-type*
  • circular-list
  • clear-traces!
  • coerce-boolean
  • combine-elements
  • compose
  • compose-1v
  • composite-lesser?
  • cond-replace
  • copy-object
  • csubtypecase
  • curry-left
  • curry-right
  • decode-time-duration
  • defclass*
  • defvar-unbound
  • delete-nth!
  • designated-class
  • designated-function
  • doseq
  • duplicates-p
  • empty?
  • english-list-format-control
  • ensure-type
  • eof-p
  • equivalent-hash-table-test
  • esubtypecase
  • find-duplicates
  • format-ordinal
  • format-time-duration
  • fractional
  • get-reasonable-real-time
  • get-reasonable-run-time
  • group-by-n
  • hash-table->alist
  • insert-at
  • integer->twos-complement
  • integer-digit-count
  • integer-digits
  • iterate-alist
  • iterate-plist
  • lambda*
  • lesser?
  • list-extract!
  • list-traces
  • map-adjacent-pairs
  • map-lines
  • mean
  • merge-alists
  • nsort
  • nstable-sort
  • nth-arg
  • option-clause-bind
  • package<
  • parse-progn
  • parse-sequence-type
  • parse-vector-type
  • partition-list
  • partition-set
  • plist->alist
  • proper-list?
  • push-append
  • push-nconc
  • read-lines
  • read-new-value
  • remove-duplicate-properties
  • remove-ordered-duplicates
  • set-equal
  • shuffle
  • shuffle!
  • sort
  • split-list!
  • square
  • stable-sort
  • standard-deviation
  • string-begin-equal
  • string-begin=
  • string-end-equal
  • string-end=
  • subseq*
  • subseq-displace
  • subtype-error-expected-supertype
  • subtype-error-type
  • subtypecase
  • symbol<
  • test-order-pred
  • twos-complement->integer
  • unique-pairs
  • vector-delete
  • vector-delete-range
  • verbosely
  • with-accessors*
  • with-extent-hooks
  • with-extent-hooks%
  • with-gensyms
  • with-list-iterator
  • with-range-iterator
  • with-safe-alloc
  • with-sequence-iterator
  • with-trace
  • with-vector-iterator
  • with-verbosity
  • xor
  • zip
  • zip*

変数

  • *verbose*

  • array-dimension
  • array-index
  • class-designator
  • extended-function-designator
  • format-control
  • function-designator
  • function-name
  • pathname-designator
  • subsecond-universal-time
  • subtype-error
  • universal-time

 面白そうなものを数点取り上げると、
formatの指示子が憶えられないので作られたような、english-list-format-control

(jpl-util:english-list-format-control)
;=>  "~#[~;~A~;~A and ~A~:;~@{~#[~;and ~]~A~^, ~}~]"

(format t (jpl-util:english-list-format-control "~A" "or") 1 2 3 4) ;>> 1, 2, 3, or 4 ;=> NIL

(format t (jpl-util:english-list-format-control) 1) ;>> 1 ;=> NIL

(format t (jpl-util:english-list-format-control) 1 2) ;>> 1 and 2 ;=> NIL

(format t (jpl-util:english-list-format-control)) ;=> NIL

(format t (jpl-util:english-list-format-control "~A" "そして") 1 2 3 4) ;>> 1, 2, 3, そして 4 ;=> NIL

良く使いそうな型の定義

(typep '(setf foo) 'jpl-util:function-name)
;=>  T

(typep -1 'jpl-util:universal-time) ;=> NIL

他ありがちな状況のためのもの

(jpl-util:coerce-boolean (member 'foo '(foo bar baz)))
;=>  T

位でしょうか。

まとめ

 今回は、cl-jpl-utilを紹介してみました。
cl-jpl-utilまさに日常的にCommon Lispを書いていて必要になったのをまとめたという感じのユーティリティですね。

SCLINTの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の288日目です。

SCLINTとはなにか

 SCLINTは、Pertti Kellomäki氏作のScheme(R4RS)版のLintです。

パッケージ情報

パッケージ名SCLINT
CMU AI レポジトリPackage: lang/scheme/code/debug/sclint/

インストール方法

 ダウンロードしてきて展開するだけで使えますが、実行スクリプトではscmで実行するようになっています。

試してみる

 こんな感じの、foo.scmというファイルがあったとして、

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

(if 1 2 3 4)

(define)

(let () a)

(if (= car x 0) a b)

(define morlis (lambda (x) x))

(define (morlis y) y)

$ sclint foo.scm

でチェックすると

sclint v. 0.9, Pertti Kellomaki 1992
Reading source files: /home/mc/sclint/foo.scm, done.
Checking indentation...done.
Checking special forms and argument counts...done.
foo.scm:3:Indentation does not match the logical structure.
foo.scm:4:Indentation does not match the logical structure.
foo.scm:7:Wrong number of subexpressions in if.
foo.scm:10:Missing variable and expression in a define form.
foo.scm:13:No bindings in a binding list. You should probably use begin instead.
foo.scm:16:Variable not defined in lexical context: x
foo.scm:17:Variable not defined in lexical context: a
foo.scm:18:Variable not defined in lexical context: b
foo.scm:21:Duplicate definition of morlis
foo.scm:24:Duplicate definition of morlis

のような感じでチェックしてくれます。
チェックしてくれるポイントですが、

  • インデントのずれ
  • 引数の数のチェック
  • 特殊形式の使い方
  • 重複した定義
  • 定義されていない変数

あたりのようです。
コードを眺めると移植性が高そうだったのでSagittariusで実行してみましたが、そのまま実行できるようです。
こんな感じにシェルスクリプトにできます。

#!/usr/bin/env sash

(import (rnrs))

(define SCLINTHOME ".../sclint/")

(for-each (lambda (f) (load (string-append SCLINTHOME f))) '("pexpr.scm" "read.scm" "environ.scm" "special.scm" "procs.scm" "top-level.scm" "checkarg.scm" "sclint.scm" "match.scm" "indent.scm"))

(sclint (cdr (command-line)))

まとめ

 今回は、SCLINTを紹介してみました。
1992年のものということで大分古いものですが、割合に今でも使えそうです。
主に教育目的での利用を想定しているとのことですが、入門あたりなら全然使えそうではあります。

teepeedee2の紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の287日目です。

teepeedee2とはなにか

 teepeedee2は、John Fremlin氏作の高速なウェブアプリケーションのフレームワークです。

パッケージ情報

パッケージ名teepeedee2
Quicklisp
CLiKiCLiki: teepeedee2
Quickdocsteepeedee2 | Quickdocs
common-lisp.netteepeedee2 (tpd2)
CL Test Grid: ビルド状況teepeedee2 | CL Test Grid

インストール方法

(ql:quickload :teepeedee2)

試してみる

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

 約5年位前に世界最速として登場したteepeedee2ですが、当時熱かった最速競争は現在どうなっているのでしょう。
2009年末にULibというC++製のものに負けてしまってから特に動きはないようです。

2009年頃、Fremlin氏は日本に住んでいたためShibuya.lispでもteepeedee2の発表があったりしました。

ちなみに、このブログも2年前からteepeedee2で動いています。

 現在、Quicklispでインストールできますが、SBCL 1.2.4+最新のteepeedee2-20140713-gitを動かす上で、2点程ハマりどころがあります。

  • 依存ライブラリが同梱されている
  • CFFIの書法が変更になった

ですが、依存ライブラリが同梱されているのは、teepeedee2ディレクトリ直下のaddonsで、alexandriaや、cl-cont等が置かれていますが、これがあるとQuicklispで提供されているライブラリとごっちゃになってややこしいことになるので、自分は、addons以下をごっそり消して使っています。
次に、CFFIの書法の違いですが、

;;; teepeedee2-20140713-git/src/io/posix-socket.lisp
(defmethod socket-accept ((fd integer))
  (cffi:with-foreign-object (sa 'sockaddr_in)
    (cffi:with-foreign-object (len :int)
      (setf (cffi:mem-aref len :int) (cffi:foreign-type-size '(:pointer (:struct sockaddr_in))))
      (let ((s
             (socket-io-syscall
              #. (progn
                   (if (accept4-supported)
                    `(syscall-accept4 fd sa len
                                      (logior
                                       0
                                       #-tpd2-untransformed-io +SOCK_NONBLOCK+
                                       )
                                      )
                    `(syscall-accept fd sa len)
                    )))))
        (case-= s
                (-1 nil)
                (t
;                (socket-set-tcp-nodelay s)
;                (socket-cork s)

                 #.(unless (accept4-supported)
                     #-tpd2-untransformed-io
                     `(set-fd-nonblock s))

(make-con :socket s :peer-info (sockaddr-address-bv sa))))))))

(defmethod socket-recvfrom ( (fd integer) buf) (cffi:with-foreign-object (sa 'sockaddr_in) (cffi:with-foreign-object (len :int) (setf (cffi:mem-aref len :int) (cffi:foreign-type-size '(:pointer (:struct sockaddr_in)))) (with-pointer-to-vector-data (ptr buf) (let ((s (socket-io-syscall (syscall-recvfrom fd ptr (length buf) 0 sa len)))) (case-= s (-1 (values nil nil)) (0 (error 'socket-closed)) (t

(let ((sa-out (make-byte-vector (cffi:mem-aref len :int)))) (loop for i from 0 below (length sa-out) do (setf (aref sa-out i) (cffi:mem-ref sa :unsigned-char i))) (values s sa-out)))))))))

(defmethod socket-peer ((fd integer)) (cffi:with-foreign-object (sa 'sockaddr_in) (cffi:with-foreign-object (len :int) (setf (cffi:mem-aref len :int) (cffi:foreign-type-size '(:pointer (:struct sockaddr_in)))) (when (zerop (getpeername fd sa len)) (sockaddr-address-string sa)))))

;;; teepeedee2-20140713-git/src/io/syscalls.lisp (defun new-socket-helper (&key port address socket-family socket-type action) (let ((fd (syscall-socket socket-family socket-type 0))) (signal-protect (let ((network-port (htons port))) (setsockopt-int fd +SOL_SOCKET+ +SO_REUSEADDR+ 1) (set-fd-nonblock fd) (with-foreign-object-and-slots ((addr port family) sa (:struct sockaddr_in)) (setf family socket-family) (cffi:with-foreign-string (src address) (when (<= (inet_pton socket-family src (cffi:foreign-slot-pointer sa '(:struct sockaddr_in) 'addr)) 0) (error "Internet address is not valid: ~A" address))) (setf port network-port) (funcall action fd sa (cffi:foreign-type-size '(:struct sockaddr_in)))) fd) (syscall-close fd))))

こんな感じに直します(自信がないので間違っていたら教えて下さい)。
書法の違いについては、他の箇所でも警告が出ますが、致命的なのはこれだけなので、ここを修正すれば動かすことが可能です。

速度はどんなものなのか

 5年前に比べればマシンも速くなったことですし、このブログのページをローカルで動かして速度を計測してみます。

$ ab -n 100000 -c 10 'http://127.0.0.1:8200/3622147200'
This is ApacheBench, Version 2.3 <$Revision: 1604373 $>
Copyright 1996 Adam Twiss, Zeus Technology Ltd, http://www.zeustech.net/
Licensed to The Apache Software Foundation, http://www.apache.org/

Benchmarking 127.0.0.1 (be patient) Completed 10000 requests Completed 20000 requests Completed 30000 requests Completed 40000 requests Completed 50000 requests Completed 60000 requests Completed 70000 requests Completed 80000 requests Completed 90000 requests Completed 100000 requests Finished 100000 requests

Server Software: Server Hostname: 127.0.0.1 Server Port: 8200

Document Path: /3622147200 Document Length: 23193 bytes

Concurrency Level: 10 Time taken for tests: 6.297 seconds Complete requests: 100000 Failed requests: 0 Total transferred: 2327400000 bytes HTML transferred: 2319300000 bytes Requests per second: 15881.32 [#/sec] (mean) Time per request: 0.630 [ms] (mean) Time per request: 0.063 [ms] (mean, across all concurrent requests) Transfer rate: 360958.82 [Kbytes/sec] received

Connection Times (ms) min mean[+/-sd] median max Connect: 0 0 0.0 0 0 Processing: 0 1 0.8 1 85 Waiting: 0 1 0.8 1 85 Total: 0 1 0.8 1 85

Percentage of the requests served within a certain time (ms) 50% 1 66% 1 75% 1 80% 1 90% 1 95% 1 98% 1 99% 1 100% 85 (longest request)

$ ab -n 100000 -c 10 'http://127.0.0.1:8200/3620998320'
This is ApacheBench, Version 2.3 <$Revision: 1604373 $>
Copyright 1996 Adam Twiss, Zeus Technology Ltd, http://www.zeustech.net/
Licensed to The Apache Software Foundation, http://www.apache.org/

Benchmarking 127.0.0.1 (be patient) Completed 10000 requests Completed 20000 requests Completed 30000 requests Completed 40000 requests Completed 50000 requests Completed 60000 requests Completed 70000 requests Completed 80000 requests Completed 90000 requests Completed 100000 requests Finished 100000 requests

Server Software: Server Hostname: 127.0.0.1 Server Port: 8200

Document Path: /3620998320 Document Length: 12550 bytes

Concurrency Level: 10 Time taken for tests: 5.910 seconds Complete requests: 100000 Failed requests: 0 Total transferred: 1263100000 bytes HTML transferred: 1255000000 bytes Requests per second: 16919.21 [#/sec] (mean) Time per request: 0.591 [ms] (mean) Time per request: 0.059 [ms] (mean, across all concurrent requests) Transfer rate: 208697.85 [Kbytes/sec] received

Connection Times (ms) min mean[+/-sd] median max Connect: 0 0 0.0 0 0 Processing: 0 1 1.1 1 113 Waiting: 0 1 1.1 1 113 Total: 0 1 1.1 1 113

Percentage of the requests served within a certain time (ms) 50% 1 66% 1 75% 1 80% 1 90% 1 95% 1 98% 1 99% 1 100% 113 (longest request)

計測に利用したマシンは、Xeon E3-1230 v3 @ 3.30GHzのマシンです。

のページだと10万リクエストを6.297秒で処理(15880request/sec)。
ちょっと短かめの

のページだと、10万リクエストを5.910秒で処理(16920reqest/sec)でした。
これはローカルで直にアクセスした場合で、このブログようにリバースプロキシを利用すれば、それだけで大分速度は低下しますし、ネットの速度も大きく影響するので、さくらVPS上のこのブログのような場合、50request/secも出せてないかなと思います。

まとめ

 今回は、teepeedee2を紹介してみました。
ちなみに、このブログの年間PVはteepeedee2だと2秒程度で処理できます。

cl-quickcheckの紹介

Posted 2014-10-13 00:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の286日目です。

cl-quickcheckとはなにか

 cl-quickcheckは、Darius Bacon氏作の

パッケージ情報

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

インストール方法

(ql:quickload :cl-quickcheck)

試してみる

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

 QuickCheckは元々はHaskellの為のツールだったようですが、他の言語にも類似のものが作られていて、cl-quickcheckもその一つのようです。

QuickCheckは仕様を与えることによりテストするデータを自動生成してテストを実行します。
標準で用意されているジェネレータは下記の通りです。

  • a-member
  • a-list
  • an-integer
  • a-tuple
  • a-char
  • an-index
  • a-boolean
  • a-real
  • a-symbol
  • a-string
(funcall an-index)
;=>  11

(funcall an-integer) ;=> -11

(funcall a-real) ;=> 10.608702

(a-char) ;=> #\E

(funcall a-boolean) ;=> T (a-symbol) ;=> |¢TK9:6~¢?9| ; NIL (a-string) ;=> "©ìÛ6"

(funcall (a-list an-index)) ;=> (16 12 3 11 9 15 19 7 4 19 13 18 8)

(funcall (a-tuple an-index a-boolean)) ;=> (2 NIL)

(funcall (a-member an-integer (a-list an-index) a-boolean)) ;=> 2

こんな感じにランダムなデータを作ることが可能です。

 これらのジェネレータで生成するデータをテストを指定してfor-allの中で回します。
テストには、test、is、isnt、is=、isnt=が使えます。
testは式が真かどうかをテスト、is=は、2つの式をequalを使ってチェック、isは、is=の述語を指定する版(removeに対するremove-if的なもの)です。

(quickcheck 
  (for-all ((a (a-list an-integer))
            (b (a-list an-integer)))
    ;; 
    (cl-quickcheck:is= `(,@a ,@b)
                       (append a b))))
;>>  Starting tests with seed #S(RANDOM-STATE :STATE #.(MAKE-ARRAY 627 :ELEMENT-TYPE
;>>                                                                '(UNSIGNED-BYTE
;>>                                                                  32)
;>>                                                                :INITIAL-CONTENTS
;>>                                                                ...))
;>>  ....................................................................................................
;>>  1 test submitted; all passed.
;=>  T

(quickcheck (for-all ((n a-real)) (is= (= 0 n) (zerop n)))) ;>> Starting tests with seed #S(RANDOM-STATE :STATE #.(MAKE-ARRAY 627 :ELEMENT-TYPE ;>> '(UNSIGNED-BYTE ;>> 32) ;>> :INITIAL-CONTENTS ;>> ...)) ;>> .................................................................................................... ;>> 1 test submitted; all passed. ;=> T

(quickcheck (for-all ((n a-real)) (is= (= 0 n) (zerop n))))

(quickcheck (for-all ((n a-real)) (is eq (= 0 n) (zerop n))))

;;; zerop test (quickcheck (for-all ((x (a-member an-integer (a-list an-index) a-boolean))) (only-if (numberp x) (is eq (= 0 x) (zerop x))) (only-if (not (numberp x)) (should-signal 'CL:ERROR (zerop x)))))

 それぞれのテストで囲みたい式がある場合はwrap-eachという構文が使えます。

(import 'cl-quickcheck::wrappee)

(quickcheck (for-all ((x a-real)) (wrap-each (progn (format t "~S == ~S~%" `(= 0 ,x) `(zerop ,x)) WRAPPEE) (is= (= 0 x) (zerop x)))))

WRAPPEEというシンボルの所が置き換えられますが、WRAPPEEは、cl-quickcheck::wrappeeでないといけません。しかしエクスポートされていないので注意(割とありがち)。

 他便利ジェネレータが用意されています。

(for-all ((k k-generator))
  (is= k k))

(for-all (k) (is= k k))

;;; (for-all (n m) (is= (+ n m) (+ m n)))

(for-all ((n n-generator) (m m-generator)) (is= (+ n m) (+ m n)))

(for-all ((n an-integer) (m an-integer)) (is= (* n m) (* m n)))

まとめ

 今回は、cl-quickcheckを紹介してみました。
cl-quickcheck網羅的にテストしたい場合には便利ですね。
ちなみにFiveAMにもQuickCheck風の機能があります。

Telos in Common Lispの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の285日目です。

Telos in Common Lispとはなにか

 Telos in Common Lispは、Russell Bradford氏作のEuLispのオブジェクト指向システムのTelosをCommon Lispに移植したものです。

パッケージ情報

パッケージ名Telos in Common Lisp
Quicklisp×
配布サイトPackage: lang/others/eulisp/feel/telos/

インストール方法

 上記の配布サイトからダウンロードしてきて動かします。
もしくは、ASDF対応にしてみたものがありますので、良かったらどうぞ。
Quicklispのlocal-projects以下に配置すれば、

(ql:quickload :telos)

で読み込めます。

試してみる

 Telosは名前から察せられるようにCLOSの影響を受けているので書法も大体CLOS風です。
違いといえば、EuLispがLisp-1の為、CLOSのように名前に対して操作をするというよりはScheme上のオブジェクト指向システムと同じく無名オブジェクトを操作する感じになります。
Telos in Common LispでもCLOSでクラス名が来るところは評価されるようになっています。

(defclass <foo> () ())

<foo> ;=> #class(foo [simple-class])

こんな感じに変数の値としてクラスオブジェクトが入るので、名前の衝突を防ぐために<クラス名>という命名規約が有用になってきます(とはいえCommon Lispでも真似してる人もいますが)。

 ということで、毎度お馴染BankAccountを書いてみます。

(defpackage :telos.demo
  (:use :telos :cl)
  (:shadowing-import-from :telos
   :slot-value :remove-method :make-method :find-method :describe :defmethod
   :defgeneric :defclass :class-of :class-name :call-next-method :call-method
   :add-method))

(cl:in-package :telos.demo)

(defclass <bank-account> () ((dollars :default 0 :accessor dollars :keyword :dollars)))

(defgeneric deposit ((a <bank-account>) (n <number>)))

(defmethod deposit ((a <bank-account>) (n <number>)) (incf (dollars a) n))

(defgeneric withdraw ((a <bank-account>) (n <number>)))

(defmethod withdraw ((a <bank-account>) (n <number>)) (setf (dollars a) (max 0 (- (dollars a) n))))

(defparameter *my-account* (make <bank-account> :dollars 200))

(dollars *my-account*) ;=> 200

(deposit *my-account* 50) ;=> 250

(withdraw *my-account* 100) ;=> 150

(withdraw *my-account* 200) ;=> 0

(defclass <stock-account> (<bank-account>) ((num-shares :default 0 :accessor num-shares :keyword num-shares) (price-per-share :default 30 :accessor price-per-share :keyword price-per-share)))

(defgeneric dollars ((a <stock-account>)))

(defmethod dollars ((a <stock-account>)) (* (num-shares a) (price-per-share a)))

(defgeneric (setf dollars) ((a <stock-account>) (n <number>))) ;CLOSと引数の順番が逆

(defmethod (setf dollars) ((a <stock-account>) (n <number>)) (setf (num-shares a) (/ n (price-per-share a))) (dollars a))

(defparameter *my-stock* (make <stock-account> :num-shares 10))

(dollars *my-stock*) ;=> 300

(setf (dollars *my-stock*) 600) ;=> 600

(deposit *my-stock* 60) ;=> 660

(num-shares *my-stock*) ;=> 22

(withdraw *my-stock* 120) ;=> 540

(num-shares *my-stock*) ;=> 18

微妙に違いますが、大体同じなのが分かると思います。
defclassのオプション等はTelosの方が直感的で暗記しやすいかも

によるとMOPもサポートということなので、簡単そうなところでシングルトンクラスを書いてみます。

(defclass <singleton-class> (<simple-class>)
  ((instance :default '())))

(defun make-singleton (cl &rest keywords) (or (and (eq <singleton-class> (class-of cl)) (slot-value cl 'instance)) (let ((inst (initialize (allocate cl keywords) keywords))) (setf (slot-value cl 'instance) inst) inst)))

(defclass <kandi> () ((s :default 0 :keyword :s)) :class <singleton-class>)

(eq (make-singleton <kandi>) (make-singleton <kandi>)) ;=> T

ご覧のようにメタクラスにスロットが付いてるだけという、非常に残念なものになりました。
一応言い訳としては、

  • makeが総称関数でない
  • allocateでクラスからインスタンスを生成してinitializeで初期化。allocateでキャッシュするとしても、二回目以降にinitializeを迂回する良い方法がない。

ということで悩んでmake-singletonを作成するということに。
initializeがclass-slotsを呼ぶので、class-slotsを特定化しても迂回できそうですが、class-slotsも普通の関数。
他に考えられるとしたら、シングルトンクラスのスロットを専用のものにして再初期化を迂回する、等でしょうか。
Telosの作法ではどうするのが正しいのか知りたいところです。

まとめ

 今回は、Telos in Common Lispを紹介してみました。
<クラス名>はLisp-1では必然なのですが、Lisp-2では皆無かというとそうでもなく、ISLispの仕様ではそういう感じになっていたりします。
ISLispは、Lisp-1かLisp-2かで揺れていたようで、<クラス名>を受けつけるオペレーターは全部スペシャルフォームになっていて、クォートは付けなくて良いようになっていたりして、なにか辻褄合わせ的なものを感じます。

CDR 9: File-local variablesの紹介

Posted 2014-10-09 22:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の283日目です。

CDR 9: File-local variablesとはなにか

 CDR 9: File-local variablesは、Didier Verna氏提案のCommon Lispでファイルローカル変数を実現する仕組みです。

パッケージ情報

パッケージ名CDR 9: File-local variables
Quicklisp×
CDRCDR 9: File-local variables
参照実装ASDF-FLV, variables locales aux fichiers par ASDF
CLiKiCLiki: asdf-flv

インストール方法

 参照実装は、Quicklispのlocal-projects以下に配置すれば、

(ql:quickload :com.dvlsoft.asdf-flv)

で利用可能です。

試してみる

 詳しくは、CDRのドキュメントに書いてあるのですが、ファイルローカルな振舞いをする変数には、*package*と*readtable*があります。この振舞いをユーザーが定義できるようにする提案です。
実際どんな所で使えそうか考えてみるに、システムの大域変数を変更してしまうようなプロジェクトをロードする時に現在の状態を保護するのにも使えたりしそうです。

;;;; asdf-flv-demo.lisp -*- Mode: Lisp;-*- 

(cl:in-package :asdf-flv-demo.internal)

;;; "asdf-flv-demo" goes here. Hacks and glory await!

(eval-when (:compile-toplevel :load-toplevel :execute) (setq *read-default-float-format* 'double-float))

(defun foo () 10.0)

;;; *EOF*

こんな感じのプロジェクトがあったとすると、そのままロードすれば、

(progn
  (asdf:load-system :asdf-flv-demo :force t)
  (type-of (read-from-string "0.0")))
;=>  DOUBLE-FLOAT

こんな感じのことになってしまいます。CL標準では、*read-default-float-format*はsingle-floatですが、読み込んだシステム内で値を上書きしてしまったので外側まで影響が及んでいます。
これがCDR 9: File-local variablesを利用すれば、

(com.dvlsoft.asdf-flv:make-variable-file-local '*read-default-float-format*)
;=>  (*READ-DEFAULT-FLOAT-FORMAT*)

(progn (asdf:load-system :asdf-flv-demo :force t) (type-of (read-from-string "0.0"))) ;=> SINGLE-FLOAT

(type-of (asdf-flv-demo.internal::foo)) ;=> DOUBLE-FLOAT

こんな感じにファイルローカルに閉じ込めることが可能です。

まとめ

 今回は、CDR 9: File-local variablesを紹介してみました。
MIT Lispマシン(Lisp machine Lisp)では、attribute list(Emacs系でお馴染の先頭行の-*- VAR0: VAL0; VARn: VALn ... -*-)でファイルローカルの変数が指定できましたが、ああいうのが利用できると便利ですね。

cl-permutationの紹介

Posted 2014-10-09 01:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の282日目です。

cl-permutationとはなにか

 cl-permutationは、Robert Smith氏作の専用のデータ構造を使ったpermutationを扱うライブラリです。

パッケージ情報

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

インストール方法

(ql:quickload :cl-permutation)

試してみる

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

 使い方はシンプルに、

(perm:make-perm 1 2 3)
;=>  #<PERM:PERM 1 2 3>

でpermutationの1つが作れます。制限として1から要素は要素の個数までの連続した数値である必要があります。

 他リストに変換したり、配置をシークエンスにマップしたり、n個の集合の置換をなめる構文、様々なユーティリティがあります。

(perm:perm-to-list (perm:make-perm 1 2 3))
;=>  (1 2 3)

(perm:doperms (p 3) (print (perm:permute p '(a b c)))) ;>> ;>> (A B C) ;>> (A C B) ;>> (C A B) ;>> (C B A) ;>> (B C A) ;>> (B A C) ;=> NIL

(perm:permute (perm:random-perm 10) (*:iota 10 100)) ;=> (103 108 102 101 100 105 104 107 109 106)

(loop :with s := '(:a :b :c) :with g := (perm:make-perm-generator (length s)) :for e := (funcall g) :while e :collect (perm:permute e s)) ;=> ((:A :B :C) (:A :C :B) (:C :A :B) (:C :B :A) (:B :C :A) (:B :A :C))

 その他、似たようなものとして、循環する配列も用意されています。

(perm:cycle-ref (perm:make-cycle 1 2 3) 8)
;=>  3

まとめ

 今回は、cl-permutationを紹介してみました。
毎度自作したりしがちなところですが、まとまったライブラリになっていると便利ですね。

#lang honuの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の281日目です。

#lang honuとはなにか

 #lang honuは、Racketの構文拡張で、RacketがC/Java/JavaScriptの構文で書けるものです。

パッケージ情報

パッケージ名#lang honu
ドキュメントRacket: Honu

試してみる

 サイトのドキュメントにはソースコードに

#lang honu

と指定するとhonuの構文で書けるみたいなことが書いてありますが、自分が確認したところでは、githubのレポジトリから入手したものでないと標準状態では有効になりませんでした。

$ git clone https://github.com/plt/racket.git
$ cd racket
$ make unix-style PREFIX=/usr/local/racket # /usr/local/racket以下に配置する場合
$ /usr/local/racket/bin/racket -Iq honu
Welcome to Racket v6.1.0.8.             
> 42+42;
84

 下記のようなスクリプトを書いて実行属性を付ければ、シェルスクリプトとして実行も可能です。

#!/usr/local/racket/bin/racket

#lang honu

function fib (n) { if (n < 2) { n; } else { fib(n - 1) + fib(n - 2); } }

printf("fib(10) => ~A\n", fib(10));)

printfの中が%d等でないのがなんでなのという感じですが、良く考えればracketにはprintfがあるので、その流儀なのでしょう。

$ ./honu.honu
fib(10) => 55

 構文的には大体C/Java/JavaScript的なところですが、まだまだドキュメントが少ないようで、表記も揺れている様子。
今のところテストコードでも眺めてみるのが良いのかもしれません。

 マクロについては現在のところDylan風のパタンマッチによるマクロがあります。

macro dotimes ()
  {var:expression limit:expression body:expression}
  {syntax( for var in 0 to limit do body )}

dotimes x 8 { printf("Hello, ") printf("World!! ~A\n", x) } Hello, World!! 0 Hello, World!! 1 Hello, World!! 2 Hello, World!! 3 Hello, World!! 4 Hello, World!! 5 Hello, World!! 6 Hello, World!! 7

 honuについて詳しくは、論文や、動画があるので参照して下さい。

また、Chickenのeggsにもなっている様子。

まとめ

 今回は、#lang honuを紹介してみました。
Racketはなんでもやりますね。

cl-logicの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の280日目です。

cl-logicとはなにか

 cl-logicは、Mikhail Klementyev氏作の論理式を扱うライブラリです。

パッケージ情報

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

インストール方法

(ql:quickload :cl-logic)

試してみる

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

 名前からすると、論理プログラミングのDSLかなにかと思ってしまいますが、そうではないようです。
ソースを眺めても説明がないのでどう使うのかと思いましたが、ソース中の定義を眺めると、

(defun ¬ (p) "Инверсия, uac" (not p))

(defun(p q) "Конъюнкция, u2227" (and p q))

(defun(p q) "Дизъюнкция, u2228" (or p q))

(defun(p q) "Импликация, u2192" (or (not p) q))

(defun(p q) "Сложение по модулю 2, u2295" (not (equal p q)))

(defun(p q) "Эквивалентность, u223c" (equal p q))

(defun(p q) "Штрих Шеффера, u2191" (not (and p q)))

(defun(p q) "Стрелка Пирса, u2193" (not (or p q)))

(defun(p list) "Предикат всеобщности" (every p list))

(defun(p list) "Предикат существования" (some p list))

こんな感じのものと、エクスポートされている、infix->prefixがあるので、

(progv '(p q) '(t t)
  (eval (infix->prefix '(¬ (p ∨ q) ∼ ¬ p ∧ ¬ q))))
;=>  T

推測するに、こんな感じに使うのではないでしょうか。

まとめ

 今回は、cl-logicを紹介してみました。
Quicklispの中にはテストケースがないものも多いですが、使い方さえ分からないものが結構あります。
Quicklispにライブラリを登録する場合には、せめてテストケースと用例位は付けましょう。

eggs: c3の紹介

Posted 2014-10-06 00:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の279日目です。

eggs: c3とはなにか

 eggs: c3は、Alex Shinn氏によるTiny CLOSのクラスの継承順位にC3線形化を導入するライブラリです。

パッケージ情報

パッケージ名eggs: c3
Chicken eggs:c3 - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install c3

すれば、

(use c3)

で使えます。

試してみる

 CLOSやTiny CLOSは多重継承が可能ですが、こんな感じの場合、

(define O <object>)

(define-class F (O) ()) (define-class E (O) ()) (define-class D (O) ()) (define-class C (D F) ()) (define-class B (D E) ()) (define-class A (B C) ())

CLOS系の標準では、Aの継承順は、

(A B C D F E object top)

と決まります。
上記では、BはCに優先していて、B>D>Eで、かつC>D>Fなのに合体するとB>C>F>Eという並びになったりするのが直感的でないですが、これをより直感的な並びにするのが、C3線形化という方式です。

(use c3)

すれば、

(map class-name (class-cpl A))
;=> ("A" "B" "C" "D" "E" "F" "object" "top")

こんな感じに並びます。
C3線形化は、元々Dylan方面の人達によって考案されたものですが、現在Python等でも採用されているようです。
C3線形化について詳しくは元論文を参照してください。

Schemeの処理系で少し調べてみた範囲では、Tiny CLOS系のオブジェクト指向システムを持つ、STklos、Gauche、Sagittariusが標準で採用しているようです(STklos系?)。
その他mosh等は、Tiny CLOSそのままの方式のようです(CLOSと同じ)。

まとめ

 今回は、eggs: c3を紹介してみました。
C3線形化では元祖と言われるDylanですが、Open Dylan(論文にあるHarlequin Dylanの後継)では、2012年にやっと導入されたという意外な話があったりします。

cl-abstract-classesの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の278日目です。

cl-abstract-classesとはなにか

 cl-abstract-classesは、Tim Bradshaw氏作のCommon Lispで抽象クラス、シングルトンクラス、ファイナルクラスを実現するメタクラスのライブラリです。

パッケージ情報

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

インストール方法

(ql:quickload :abstract-classes)

でabstract-classとfinal-classが、

(ql:quickload :singleton-classes)

でsingleton-classが使えます。

試してみる

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

 使い方は簡単で、まずabstract-classですが、

(defclass lomilwa ()
  ()
  (:metaclass final-class))

(define-final-class lomilwa () ())

(make-instance 'lomilwa) ;=> #<LOMILWA {1014121093}>

(defclass kandi (lomilwa) ()) ;!> Attempting to subclass a final class

こんな感じで使えます。:metaclassを毎度書くのが面倒なので専用の構文も提供されています。実装は、make-instanceで直接abstract-classを生成しようとしたらエラーにするというシンプルなもの。

(defmethod make-instance ((c abstract-class) &rest junk)
  (declare (ignore junk))
  (error "Trying to make an instance of ~A which is an abstract class"
	 (class-name c)))

 次に、final-classですが、

(defclass lomilwa ()
  ()
  (:metaclass final-class))

(define-final-class lomilwa () ())

(make-instance 'lomilwa) ;=> #<LOMILWA {1014121093}>

(defclass kandi (lomilwa) ()) ;!> Attempting to subclass a final class

この実行例で分かるように継承して使うことができません。
実装は、validate-superclassのチェック時でサブクラスの生成を弾くというもの。なるほど。

(defmethod validate-superclass ((class standard-class)
				(superclass final-class))
  (error "Attempting to subclass a final class"))

 そして、singleton-classですが、

(defclass zilwan ()
  ()
  (:metaclass singleton-class))

(eq (make-instance 'zilwan) (make-instance 'zilwan)) ;=> T

こんな感じに使えて、実装は、make-instanceがキャッシュしたものを返すことで唯一性を保証するというものです。

(defmethod make-instance ((class singleton-class)
                          &key)
  (with-slots (instance) class
    (or instance
        (setf instance (call-next-method)))))

まとめ

 今回は、cl-abstract-classesを紹介してみました。
結構昔からウェブサイトで公開されていましたが、いつの間にかQuicklispに含まれるようになっていたんですね。
しかし、このパッケージ名では、final-classとsingleton-classが含まれていることが分からないかも。

anaphoric-variantsの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の276日目です。

anaphoric-variantsとはなにか

 anaphoric-variantsは、HexstreamことJean-Philippe Paradis氏作のアナフォリックマクロの一種です。

パッケージ情報

パッケージ名anaphoric-variants
Quicklisp
プロジェクトサイトanaphoric-variants | Libraries | HexstreamSoft
CL Test Grid: ビルド状況anaphoric-variants | CL Test Grid

インストール方法

(ql:quickload :anaphoric-variants)

試してみる

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

 anaphoric-variantsはアナフォリックマクロとしてはちょっと毛色が変わっていて、構文乗っ取り型のマクロです。

(anaphoric it
  (if :foo
      it))

こんな感じに書きますが、ifのフォームでitが使えるようになっているように見えつつも実際は、ifのフォーム自体がanaphoricという構文の引数になっているという感じです。

 標準では

  • and
  • or
  • cond
  • if
  • when
  • unless
  • prog1
  • case
  • ccase
  • ecase
  • typecase
  • ctypecase
  • etypecase

のフォームが定義されています。

(anaphoric it
  (cond (:foo it)
        (T nil)))
;=>  :FOO

(anaphoric it (when :foo it)) ;=> :FOO

(anaphoric it (and (assoc :a '((:a . 1) (:b . 2))) (cdr it))) ;=> 1

(anaphoric it (case :a (:a it) (:b it))) ;=> :A

(anaphoric it (typecase :a (keyword it) (t it))) ;=> :A

(anaphoric it (typecase :a (keyword (list it)))) ;=> (:A)

 caseとかtypecaseあたりは、あまり使い出がなさそうだなと言う感じですが、

(anaphoric (it :type type)
  (typecase :a
    (keyword (list type it))
    (t (list type it)))
;=>  (KEYWORD :A))

のように拡張した構文も用意されています。
また、ユーザーが新たに定義することも可能です。

まとめ

 今回は、anaphoric-variantsを紹介してみました。
アナフォリック系のマクロとしては、itのシンボルの問題も無いですし、割合に使い勝手も良い感じではないでしょうか。

eggs: debugの紹介

Posted 2014-10-02 00:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の275日目です。

eggs: debugとはなにか

 eggs: debugは、Peter Danenberg氏作のChicken用の関数のトレースやprintデバッグのためのユーティリティです。

パッケージ情報

パッケージ名eggs: debug
Chicken eggs:debug - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install debug

すれば、

(use debug)

で使えます。

試してみる

 実行トレースにはtraceが用意されていて、プリントデバッグ用の関数はdebugが用意されています。

(define (repeat n)
  (if (zero? n)
      #f
      (repeat (- n 1))))

(trace repeat)

(repeat 8) ;>> ;; Arguments to repeat: (8) ;>> ;; Arguments to repeat: (7) ;>> ;; Arguments to repeat: (6) ;>> ;; Arguments to repeat: (5) ;>> ;; Arguments to repeat: (4) ;>> ;; Arguments to repeat: (3) ;>> ;; Arguments to repeat: (2) ;>> ;; Arguments to repeat: (1) ;>> ;; Arguments to repeat: (0) ;>> ;; Values from repeat: (#f) ;>> ;; Values from repeat: (#f) ;>> ;; Values from repeat: (#f) ;>> ;; Values from repeat: (#f) ;>> ;; Values from repeat: (#f) ;>> ;; Values from repeat: (#f) ;>> ;; Values from repeat: (#f) ;>> ;; Values from repeat: (#f) ;>> ;; Values from repeat: (#f) ;=> #f

(define (repeat n)
  (if (zero? n)
      #f
      (debug (repeat (- n 1)))))

(repeat 8) ;>> (((repeat (- n 1)) => #f)) ;>> (((repeat (- n 1)) => #<unspecified>)) ;>> (((repeat (- n 1)) => #<unspecified>)) ;>> (((repeat (- n 1)) => #<unspecified>)) ;>> (((repeat (- n 1)) => #<unspecified>)) ;>> (((repeat (- n 1)) => #<unspecified>)) ;>> (((repeat (- n 1)) => #<unspecified>)) ;>> (((repeat (- n 1)) => #<unspecified>)) ;=> #f

 デバッグの出力の制御の為にパラメータdebug?が設定されています。(debug? #t)で有効、(debug #f)で無効にできますが、パラメータなので動的に変更できると思いきや、そうでもないようで、これは仕様なのかバグなのか。

まとめ

 今回は、eggs: debugを紹介してみました。
traceだけでuntraceがないというのも珍しいですね。

QITAB: declare-indentationの紹介

Posted 2014-09-30 22:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の274日目です。

QITAB: declare-indentationとはなにか

 QITAB: declare-indentationは、ITAで利用されているCommon Lisp側からEmacsのインデントを宣言するユーティリティです。Scott McKay氏作の模様。

パッケージ情報

パッケージ名QITAB: declare-indentation
Quicklisp×
プロジェクトサイトQITAB - a collection of free Lisp code

インストール方法

 common-lisp.netからITAで利用されているユーティリティのスナップショットが入手できるので、これをダウンロードします。

目的のファイルは、

  • lisp/quux/macros.lisp
  • lisp/libs/slime/site-init.lisp

です。

試してみる

 一応上記に入手方法は書いてみましたが、長くないので掲載してみます。パッケージ等は適当に調整して下さい。
ちなみに、QResという飛行機チケットの予約システムの中のコードのようです。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar *indentation-hints* (make-hash-table)
    "The key is an OPERATOR such as a symbol naming a macro.
     The value is instructions about how to indent forms
     starting with that operator.  Values are e.g.
     (5 &body), let, (6 6 6 (&whole 4 1 &rest 1) &rest 2).")

(defmacro declare-indentation (operator &rest arguments)

"Define a cl-indent spec for OPERATOR. OPERATOR is a symbol naming a function or macro and ARGUMENTS is either a cl-indent spec list or a symbol specifying that OPERATOR should be indented just like that symbol. Calls to this macro are typically near the operator's definition."

`(eval-when (:compile-toplevel :load-toplevel :execute) (setf (gethash ',operator *indentation-hints*) ',(if (and (= 1 (length arguments)) (symbolp (first arguments))) (first arguments) arguments)) ',operator)))

;;;; * Qres indentation hints ;;; This list of tables is used by contrib/swank-indentation.lisp, ;;; which we load automatically at this site. (declaim (special swank::*application-hints-tables*)) (setf swank::*application-hints-tables* ;; If the QUUX package is defined, get the value of ;; quux:*qres-indentation-hints*. (let ((qres-table (and (find-package '#:indentation-hints) (symbol-value (find-symbol (string '#:*indentation-hints*) (find-package '#:indentation-hints)))))) (if qres-table (list qres-table) '())))

 このコードは、slimeのswank-indentationに依存しているので、Emacs側で

(slime-setup '(slime-indentation))

等とするか、直接ロードしておきます。

(load
 (compile-file
  (merge-pathnames (make-pathname :name "SWANK-INDENTATION" :type "LISP" :case :common)
                   (swank-loader::contrib-dir swank-loader::*source-directory*))
  :output-file (merge-pathnames
                (make-pathname :directory '(:relative "CONTRIB")
                               :name "SWANK-INDENTATION"
                               :type "FASL"
                               :case :common)
                swank-loader::*fasl-directory*)))

等々

使い方

(defmacro mdefun (name (&rest args) &body body)
  (declare (ignore name args body)))

(declare-indentation mydefun 2 (&whole nil &rest 1) &body)

のように記述すれば、インデントが

(mydefun foo
         (a a
          a a)
  x
  x
  x)

こんな感じになります。

MIT系Lispでのインデントについて

&restと&bodyについて

 基本的にLispを書いている人はエディタにインデントを任せているので、インデントがどうというのは殆ど気にしていないかと思いますが、&rest型と&body型でインデントが違っています。

 &rest型が基本で、これは関数で利用されています。引数は縦に整列しますが、第一引数の前に改行があるとスペース1つでインデントされます。
6、70年代位は、このインデントの方式が非常に多いようなので、ここから色々と進化していったのかもしれません。

0123456789
|&rest
||&body
|||

(list x x x )

0123456789 |&rest ||&body |||

(list x x x)

 次に&body型ですが、&bodyで指定した以降が、スペース2つでインデントされます。

0123456789
|&rest
||&body
|||&rest

(progn x x x)

0123456789 |&rest ||&body |||&rest

(progn x x x)

ということで、関数とマクロ(スペシャルフォーム)は微妙にインデントで区別できたりします(二者に共通のパタンは関数で利用することが多いかなと思います)。
slimeを利用している場合、マクロの&body以降は2スペースにしてくれるので大抵これで間に合うのですが、Emacsのデフォルトが気に入らない場合、カスタマイズすることになります。
しかし、Common Lispを書いている時にEmacs Lisp側の設定を書くのが億劫なので、こういう場合に便利に使えるのではないでしょうか。

インデントパタンの記述について

 毎度Emacsのインデント記述の書法を忘れてしまうので自分の備忘録代わりにメモしてみたいと思います。

(defmacro mdefun (name (&rest args) &body body)
  (declare (ignore name args body)))

のような場合、Emacsのデフォルトだと、

(mdefun
    foo
    (a a
     a a)
  b
  b
  b)

(mdefun foo (a a a a) b b b)

のように揃います。
これはオペレーター名と第一引数は、4つスペースのインデントにして、第二引数以降は&bodyの2つスペースにするようになっています。
自分的にはLispマシン風に、オペレーター名の後で改行した場合は、prognと同じで、

(mdefun
  name
  (arg arg
   arg arg)
  body
  body
  body)

第一引数の後で改行した場合は、第二引数は第一引数と同じ位置にし、第三引数以降はprognと同じにしたいところです。

(mdefun name
        (arg arg
         arg arg)
  body
  body
  body)

この場合、

(declare-indentation mdefun 2 (&whole nil 1 &rest 1) &body)

と指定できますが、最初はフォーム名、以降は、

  1. 2: 2つスペース
  2. (
    1. &whole: サブフォーム全体のインデント開始位置。nilの指定は、直前から引き継ぐので、2つスペース
    2. 1: サブフォーム内はスペース1のインデント
    3. &rest 1: 以降はスペース1つでインデント
    )
  3. &bodyの指定で、それ以降は、2つスペースのインデント

という内容になっています。

まとめ

 今回は、QITAB: declare-indentationを紹介してみました。
Zetalispや、emacsでは

(declare (zwei:indentation 1 1))

のようにdeclareで宣言できたりします。
開発環境と言語機能がごっちゃになっていて気持ち悪いというところもありますが、LispらしいといえばLispらしいかなと思います。

CLOCC/cllib: emacs lispの紹介

Posted 2014-09-29 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の273日目です。

CLOCC/cllib: emacs lispとはなにか

 CLOCC/cllib: emacs lispは、Sam Steingold氏作のCommon LispでEmacs Lispのコードを利用するためのライブラリです。

パッケージ情報

パッケージ名CLOCC/cllib: emacs lisp
プロジェクトサイト CLOCC - Common Lisp Open Code Collection / Hg / [5dc26c] /src/cllib/emacs lisp.lisp

インストール方法

 CLOCCのプロジェクトサイトからダウンロードしてきて適当に導入します。

$ hg clone http://hg.code.sf.net/p/clocc/hg clocc-hg

で全体のソースも取得できます。
cllib/emacs lisp が目的のソースです。

試してみる

 cllibの中にあるということで、cloccというよりは、cllibの一部かなと思います。
定義されているのは、こんな感じですが、

  • %
  • /
  • add-hook
  • add-to-list
  • autoload
  • buffer-read-only
  • char-to-string
  • concat
  • decode-time
  • defalias
  • default-value
  • defconst
  • defcustom
  • defface
  • defgroup
  • define-key
  • delete
  • delq
  • directory-files
  • display-color-p
  • emacs-home
  • encode-time
  • eval-when-compile
  • expand-file-name
  • featurep
  • features
  • file
  • file-directory-p
  • file-exists-p
  • file-truename
  • format
  • fset
  • global-map
  • help-char
  • help-for-help
  • help-form
  • hook
  • if
  • ignore
  • indent-tabs-mode
  • int-to-string
  • interactive
  • let
  • let*
  • load
  • load-path
  • make-emacs lisp-readtable
  • make-help-screen
  • make-mode-line-mouse-map
  • make-sparse-keymap
  • mapconcat
  • member
  • memq
  • message
  • mode-line-format
  • number-to-string
  • propertize
  • provide
  • put
  • read-emacs lisp-special
  • remove-hook
  • require
  • run-hooks
  • save-excursion
  • save-window-excursion
  • set-default
  • setcar
  • setcdr
  • setq-default
  • sexp
  • sit-for
  • site-lisp-dir
  • sref
  • start-kbd-macro
  • string-to-int
  • string-to-number
  • substitute-command-keys
  • substitute-key-definition
  • substring
  • while
  • window-system
  • with-output-to-temp-buffer

良く使いそうなところは定義されている感じはします。

 Emacs Lisp用のリードテーブルも定義してあります。

(*:register-readtable :el cllib::+emacs lisp-readtable+)

(with-input-from-string (in "[1 2 3 4] ?a ?b ?c \"foo\\nbar\\nbaz\\n\" ") (let ((*readtable* (*:find-readtable :el)) xpr) (el::while (not (eq in (setq xpr (read in nil in)))) (print xpr)))) ;>> ;>> #(1 2 3 4) ;>> #\a ;>> #\b ;>> #\c ;>> "foo ;>> bar ;>> baz ;>> " ;=> NIL

 元々はEmacs Lispのファイルをロードしたりコンパイルしたりすることが目的のようなのでリードテーブルが定義されているのも当然といえば当然かもしれません。
これ位のファイルなら

(defun foo (n)
  n)

(defun bar (n) (message (format "hello %s" n)))

こんな感じでファイルをコンパイルして実行できます。

(el::compile-file "/tmp/foo.el")
(el::load "/tmp/foo")

(el::foo 8) ;=> 8 (el::bar "foo") ;>> hello %s ;=> NIL

コメントでは、emacsのcalendarをコンパイルしているようですが、現在はそのままではコンパイルできないようです。結構前のemacsかもしれません。

まとめ

 今回は、CLOCC/cllib: emacs lispを紹介してみました。
Emacs Lispのコードがロードできると便利なこともありそうですね。

mcsの紹介

Posted 2014-09-28 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の272日目です。

mcsとはなにか

 mcsは、Juergen Kopp氏が中心となって開発していたCLOSやTELOSの流れを汲むMOPを具備したオブジェクト指向システムです。
かつてドイツにあった、GMD(Gesellschaft für Mathematik und Datenverarbeitung mbH)で開発されていたようです。

パッケージ情報

配布サイトPackage: lang/lisp/oop/non_clos/mcs/
パッケージ名mcs
Quicklisp×

インストール方法

 上記の配布サイトからダウンロードしてきて適当にANSI CLで動くようにします。
もしくは、GitHub上にSBCLで動くようにしたものがありますので良かったらどうぞ。

Quicklispのlocal-projects以下に配置すれば

(ql:quickload :mcs)

できるかと思います。

試してみる

 mcsは以前も紹介したことがありましたが、主にMOP的なところを紹介してみていました。

 今回は、毎度お馴染のBankAccountです。

(defpackage :mcs.demo
  (:use :mcs))

(cl:in-package :mcs.demo)

(defabstract bank-account () ((dollars :initform 0 :accessor dollars :initarg dollars)))

(defclass normal-bank-account (bank-account) ())

(defmethod deposit ((a normal-bank-account) (n number)) (incf (dollars a) n))

(defmethod withdraw ((a normal-bank-account) (n number)) (setf (dollars a) (max 0 (- (dollars a) n))))

(defparameter *my-account* (make-instance 'normal-bank-account 'dollars 200))

(dollars *my-account*) ;=> 200

(deposit *my-account* 50) ;=> 250

(withdraw *my-account* 100) ;=> 150

(withdraw *my-account* 200) ;=> 0

(defclass stock-account (normal-bank-account) ((num-shares :initform 0 :accessor num-shares :initarg num-shares) (price-per-share :initform 30 :accessor price-per-share :initarg price-per-share)))

(defmethod dollars ((a stock-account)) (* (num-shares a) (price-per-share a)))

(defmethod (setf dollars) ((n number) (a stock-account)) (setf (num-shares a) (/ n (price-per-share a))) (dollars a))

(defparameter *my-stock* (make-instance 'stock-account 'num-shares 10))

(dollars *my-stock*) ;=> 300

(setf (dollars *my-stock*) 600) ;=> 600

(deposit *my-stock* 60) ;=> 660

(num-shares *my-stock*) ;=> 22

(withdraw *my-stock* 120) ;=> 540

(num-shares *my-stock*) ;=> 18

見ての通り、殆どCLOSと変わらないことが分かると思います。
上記のコードで目立った違いといえば、:initargにキーワードが使えないこと位でしょうか。
defabstractは全然必要ないのですが、mcsが標準で備えているのこともあり折角なので使ってみました。他にdefmixin等があります。

まとめ

 今回は、mcsを紹介してみました。
PCL(Portable Common Loops)よりは小さくまとまっているようなのでCLOSがないレガシーなシステムへ載せるものとしては結構良いかなと思ったりします。

pdfの紹介

Posted 2014-09-27 21:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の271日目です。

pdfとはなにか

 pdfは、PDFをChickenで扱うためのライブラリです。Marc Battyani氏作のCommon LispのPDFライブラリであるcl-pdfをBruce Butterfield氏がCLOS部分を構造体を使うようにしてSchemeに移植したものをMatt Gushee氏がChickenに移植したもののようです。

パッケージ情報

パッケージ名pdf
Chicken eggs:pdf - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install pdf

すれば、

(use pdf)

(require-library pdf)

で使えます。

試してみる

 Bruce Butterfield氏のコメントによれば、当初CLOS部分の置き換えは、PLT Scheme(Racket)のクラスライブラリを使おうかと思ったそうですが、他の処理系でも使いたかったので移植性を考えて構造体を採用したそうです。

 こんな感じで書けば、

(define (Rotate-Demo)
  (with-document-to-file "Rotate-Demo.pdf"
   (let ((noto-sans (build-font "NotoSansJapanese")))
     (with-page
      (in-text-mode
       (set-font (font-name noto-sans) 36)
       (move-text 100 750)
       (draw-text "Rotate-Demo"))
      (translate 230 500)
      (do ((j 0 (+ j 1))
           (i 0.67 (* i 1.045)))
        ((= j 101))
        (in-text-mode
         (set-font (font-name noto-sans) i)
         (move-text (* i 3) 0)
         (draw-text "Rotate"))
        (rotate 18)))
     (with-page
      (in-text-mode
       (set-font (font-name noto-sans) 40)
       (move-text 230 500)
       (draw-text "That's All, Folks!"))))))

こんな感じのPDFが生成されます。

rotate-demo

まとめ

 今回は、pdfを紹介してみました。
他のSchemeの処理系にも移植とのことですが実際どうなんでしょう。ちらっと眺めた感じでは、確かにregexとfmtがあれば動きそうではあります。

regex-coachの紹介

Posted 2014-09-26 14:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の269日目です。

regex-coachとはなにか

 regex-coachは、Edi Weitz氏作の正規表現を対話的に確認/学習できるツールです。

パッケージ情報

パッケージ名regex-coach
Quicklisp×
プロジェクトサイトThe Regex Coach - interactive regular expressions

インストール方法

(ql:quickload :regex-coach)

試してみる

 Edi Weitz氏といえば、cl-ppcre等でCommon Lisp界では有名ですが、このregex-coachはcl-ppcreを利用し、LispWorksが提供する実行ファイル生成機能によって作られたアプリケーションです。

regex-coach

 ちょっと古いのが玉に瑕ですが、32bitのWindows版とLinux版があります。
プロジェクトサイトにダウンロードのリンクがありますので、ダウンロードして実行してみましょう。
Windows版はインストーラが走りますが、Linux版は実行ファイルがあるので、そのまま実行します。

まとめ

 今回は、regex-coachを紹介してみました。
ライブラリなのかというと微妙なところですが、まあ開発時に正規表現を確認できたりするので開発環境の一つということで。

closure-htmlの紹介

Posted 2014-09-25 10:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の268日目です。

closure-htmlとはなにか

 closure-htmlは、Gilbert Baumann氏作のHTMLをパーズしてLHTML等に変換したり、LHTMLをHTMLにシリアライズしたりするライブラリです。

パッケージ情報

パッケージ名closure-html
Quicklisp
CLiKiCLiki: closure-html
Quickdocsclosure-html | Quickdocs
common-lisp.netClosure HTML
CL Test Grid: ビルド状況closure-html | CL Test Grid

インストール方法

(ql:quickload :closure-html)

試してみる

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

 closure-htmlは元々、Common Lisp製のブラウザのclosureの一部でしたが、closureは最近見掛けないので、一部だったことは既に忘れ去られているのではないでしょうか。
closureは5年位前まではビルドできた記憶があります。

 chtml:parseを利用して様々な形式に出力できますが、入力としては文字列とファイルが取れます。
変換先は なんとか-sinkや、なんとか-builderというのが用意されているので目的に応じて使い分けます。
closure-htmlに含まれているのは、

  • 文字列
  • LHTML
  • PT
  • ROD
  • 文字ストリーム
  • オクテットのベクタ

です。
他にもClosure系のライブラリで幾つか定義されているかなと思います(STP等)

(chtml:parse "<b>foo</b><foo>foo</foo>" (chtml:make-string-sink))
;=>  "<HTML><HEAD></HEAD><BODY><B>foo</B>foo</BODY></HTML>"

(chtml:parse "<b>foo</b><foo>foo</foo>" (chtml:make-pt-builder)) ;=> #<SGML:PT HTML ..>

(chtml:parse "<b>foo</b><foo>foo</foo>" (chtml:make-rod-sink)) ;=> "<HTML><HEAD></HEAD><BODY><B>foo</B>foo</BODY></HTML>"

(chtml:parse "<b>foo</b><foo>foo</foo>" (chtml:make-lhtml-builder)) ;=> (:HTML NIL (:HEAD NIL) (:BODY NIL (:B NIL "foo") "foo"))

(with-output-to-string (out) (chtml:parse "<b>foo</b><foo>foo</foo>" (chtml:make-character-stream-sink out))) ;=> "<HTML><HEAD></HEAD><BODY><B>foo</B>foo</BODY></HTML>"

(chtml:parse "<b>foo</b><foo>foo</foo>" (chtml:make-octet-vector-sink)) ;=> #(60 72 84 77 76 62 60 72 69 65 68 62 60 47 72 69 65 68 62 60 66 79 68 89 62 60 ; 66 62 102 111 111 60 47 66 62 102 111 111 60 47 66 79 68 89 62 60 47 72 84 77 ; 76 62)

RODと、PTってなんだろうという感じですが、RODは、Unicodeの文字列のことで、PTは、HAXというSAXのようなAPIで利用するデータ構造のようです。
PTを扱うツールも色々あるようです。

(sgml:ppt (chtml:parse "<b>foo</b><foo>foo</foo>" (chtml:make-pt-builder)))
;>>  
;>>  | HTML
;>>  `-----.
;>>        | HEAD
;>>        | BODY
;>>        `-----.
;>>              | B
;>>              +--.
;>>              |  | "foo" 
;>>              | "foo" 
;=>  ""

ちなみに、Runeというものも見掛けるのですが、Unicodeの文字のことで、RuneのベクタがRODということみたいです。
一応RuneとRodについてはドキュメントがあるようなので紹介しておきます。

 PTや、LHTMLからのHTMLへのシリアライズは、serialize-lhtmlや、serialize-ptを利用します。

(chtml:serialize-lhtml (chtml:parse "<b>foo</b><foo>foo</foo>" (chtml:make-lhtml-builder))
                       (chtml:make-string-sink))
;=>  "<HTML><HEAD></HEAD><BODY><B>foo</B>foo</BODY></HTML>"

まとめ

 今回は、closure-htmlを紹介してみました。
Closure関係のものには独自の用語が多いのですが、解説はあまりありません…。

alist-libの紹介

Posted 2014-09-24 11:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の267日目です。

alist-libとはなにか

 alist-libは、Peter Danenberg氏作のChickenのalistのライブラリです。

パッケージ情報

パッケージ名alist-lib
Chicken eggs:alist-lib - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install alist-lib

すれば、

(use alist-lib)

で使えます。

試してみる

 srfi-1あたりにもalistを扱う関数はちょこちょこありますが、その辺とは被らないようなものが用意されているようです。
用意されているのは、こんな感じですが、名前から大体動作がわかるかなと思います。

  • alist-keys
  • alist-update!
  • alist-values
  • alist-ref
  • alist-fold
  • alist-map
  • alist-prepend!
  • alist-size
  • alist-set
  • alist-update!/default
  • alist-ref/default
(alist-map cons
           '((A . 65) (B . 66) (C . 67) (D . 68) (E . 69) (F . 70) (G . 71) (H . 72)))
;=> ((A . 65) (B . 66) (C . 67) (D . 68) (E . 69) (F . 70) (G . 71) (H . 72))

(alist-keys '((A . 65) (B . 66) (C . 67) (D . 68) (E . 69) (F . 70) (G . 71) (H . 72))) ;=> (A B C D E F G H)

(alist-values '((A . 65) (B . 66) (C . 67) (D . 68) (E . 69) (F . 70) (G . 71) (H . 72))) ;=> (65 66 67 68 69 70 71 72)

(let ((u (alist-copy '((A . 65) (B . 66) (C . 67) (D . 68) (E . 69) (F . 70) (G . 71) (H . 72))))) (alist-set! u 'A #f) u) ;=> ((A . #f) (B . 66) (C . 67) (D . 68) (E . 69) (F . 70) (G . 71) (H . 72))

(let ((u (alist-copy '((A . 65) (B . 66) (C . 67) (D . 68) (E . 69) (F . 70) (G . 71) (H . 72))))) (alist-update! u 'A (lambda (x) #f)) u) ;=> ((A . #f) (B . 66) (C . 67) (D . 68) (E . 69) (F . 70) (G . 71) (H . 72))

(alist-ref '((A . 65) (B . 66) (C . 67) (D . 68) (E . 69) (F . 70) (G . 71) (H . 72)) 'A) ;=> 65

assocしてcdrも面倒なのでalist-refは良いかもしれないですね。

まとめ

 今回は、alist-libを紹介してみました。
割合に奥が深いalist系関数。いつかalist関係の関数をまとめてみたいところです。

eggs: describeの紹介

Posted 2014-09-23 13:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の266日目です。

eggs: describeとはなにか

 eggs: describeは、Lisp方言ではお馴染のdescribeのChicken版です。

パッケージ情報

パッケージ名eggs: describe
Chicken eggs:describe - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install describe

すれば、

(use describe)

で使えます。

試してみる

 Common Lispと同じように、(describe 調べたいオブジェクト)という感じです。

(describe describe)
;>> procedure with code pointer 7ffff3359596 of length 3
;>>  0: #<procedure (string-ref str i)>
;>>  1: #<procedure (length lst355)>
;>>  2: #<procedure (list-ref lst i)>

 Chickenは対話環境でコンマから開始されるコマンドが利用できますが、「,d」でdescribeが使えるようにもなります。

#;1> ,d describe
procedure with code pointer 7f414fb1d596 of length 3
 0: #<procedure (string-ref str i)>
 1: #<procedure (length lst355)>
 2: #<procedure (list-ref lst i)>

また、非常に長いリスト等を表示する場合には長さを限定したりもできます。

(parameterize ((describe-sequence-limit 5))
  (describe (iota 100)))
;>> list of length 100
;>>  0: 0
;>>  1: 1
;>>  2: 2
;>>  3: 3
;>>  4: 4
;>>  (95 elements not displayed)

,d コマンドの場合は、第二引数に長さを記述すれば同様の効果が得られます。

 また、set-describer!でタイプに表示関数を設定することにより表示をカスタマイズすることも可能です(詳しくはドキュメントを参照のこと)。

まとめ

 今回は、eggs: describeを紹介してみました。
~/.csircで(use describe)しておくと便利だと思います。
それはさておき、Chickenのdescribeは昔は標準機能だったような記述もポツポツ見掛けますが、分離しちゃったんでしょうか。

clawkの紹介

Posted 2014-09-22 11:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の265日目です。

clawkとはなにか

 clawkは、Kenneth Michael Parker氏作のCommon Lisp上でawkのような操作を実現するライブラリです。

パッケージ情報

パッケージ名clawk
Quicklisp
Quickdocsclawk | Quickdocs
CL Test Grid: ビルド状況clawk | CL Test Grid

インストール方法

(ql:quickload :clawk)

試してみる

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

 プログラミング言語AWKの初っ端にある例ですが、こんなファイル(名前 時給 労働時間)があったとして

Beth    4.00    0
Dan     3.75    0
Kathy   4.00    10
Mark    5.00    20
Mary    5.50    22
Suzie   4.25    18

これの人数、支払いの合計、支払いの平均を集計するにはawkだと、

{ pay = pay + $2 * $3 }
END { print NR, "employees"
      print "total pay is", pay
      print "average pay is", pay/NR
    }

みたいな感じですが、ファイルを開くのを含めて同じようなものを書くとCommon Lispでは、

(with-open-file (in "/tmp/emp.data")
  (let ((employees 0)
        (pay 0))
    (loop :for line := (read-line in nil) :while line
          :do (incf employees)
              (destructuring-bind (name w h) 
                                  (ppcre:split "\\s+" line)
                (declare (ignore name))
                (incf pay (* (read-from-string w)
                             (read-from-string h)))))
    (format t "~A employees~%" employees)
    (format t "total pay is ~A~%" pay)
    (format t "average pay is ~A~%" (/ pay employees))))
;>>  6 employees
;>>  total pay is 337.5
;>>  average pay is 56.25
;>>  
;=>  NIL

こんな感じです。
これを、clawkを使って書くと

(let ((pay 0) (employees 0))
  (for-file-fields ("/tmp/emp.data" (name w h))
    (declare (ignore name))
    (incf pay ($* w h))
    (incf employees))
  (format t "~A employees~%" employees)
  (format t "total pay is ~A~%" pay)
  (format t "average pay is ~A~%" (/ pay employees)))
;>>  6 employees
;>>  total pay is 337.5
;>>  average pay is 56.25
;>>  
;=>  NIL

とまあawkっぽく書けます。

CL上でawk風の記述を支援するユーティリティ

 便利に使えるユーティリティ関数が定義されていて、CLとawkが融合したような感じで書けます。

(for-file-fields ("/tmp/emp.data")
  ($print $3 $2 $1 " :" *nf*))
;>>  
;>>  0 4.00 Beth  : 3 
;>>  0 3.75 Dan  : 3 
;>>  10 4.00 Kathy  : 3 
;>>  20 5.00 Mark  : 3 
;>>  22 5.50 Mary  : 3 
;>>  18 4.25 Suzie  : 3 
;=>  NIL

 awkのプログラムだと、BEGIN、本体、ENDという構成がありますが、

(defawk foo ()
  (begin ($print "begin!"))
  (t ($print $3 $2 $1 " :" *nf*))
  (end ($print "end!")))

(with-input-from-string (s (format nil "foo~%bar~%baz")) (foo s)) ;>> ;>> begin! ;>> foo : 1 ;>> bar : 1 ;>> baz : 1 ;>> end! ;=> NIL

という感じに記述もできます。

 また、正規表現用にリーダーマクロが定義されていて、#/.../で記述することが可能です。

(*:defreadtable :awk
  (:merge :standard)
  (:dispatch-macro-char #\# #\` #'clawk::|#`-reader|)
  (:dispatch-macro-char #\# #\/ #'clawk::|#/-reader|)
  (:case :upcase))

(*:in-readtable :awk)

(for-file-fields ("/tmp/emp.data") (match-when (#/th/ ($print $3 $2 $1 " :" *nf*)))) ;>> ;>> 0 4.00 Beth : 3 ;>> 10 4.00 Kathy : 3 ;=> NIL

 さらに、#`...`でシェルコマンドを実行した結果を処理できるようですが、どうもコードを追加しないとLispWorksでしか動かないようです。

(for-stream-lines (#`ls /tmp/`)
  ($print *FNR* " " $0))

まとめ

 今回は、clawkを紹介してみました。
素直にawkを使えば良いんじゃないのかという話もありますが、ソースを眺めると、#+Generaという記述があるように元々はSymbolicsのLispマシン上でawk的なことをやりたかった、という記事をどっかで読んだ記憶があります。

interlisp: Advisingの紹介

Posted 2014-09-21 12:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の264日目です。

interlisp: Advisingとはなにか

 interlisp: Advisingは、interlispのアドバイス機構です。

パッケージ情報

参考マニュアルInterlisp Reference Manual(1974)

インストール方法

 interlisp-10や、Interlisp-Dでは標準の機能です。

試してみる

 アドバイス機構を紹介するのも何回目かという感じですが、今回は、元祖interlispのアドバイスの紹介です。
どうも本当の元祖は、interlispに先行するBBN-LISPみたいですが、1966-1972年のマニュアルでは記載を見付けられなかったので1974年のinterlispで確認しました。
試した環境は、pdp-10で稼動するinterlisp-10です。
REPLを開くとHiと挨拶をしてくれる処理系です(Xmasメッセージもあり)

 さて機能ですが、こんな感じの関数があったとすれば、

(DEFINEQ (matu (X)
           (PRIN1 '>>)
           (SPACES 1)
           (PRIN1 X)
           (TERPRI)))

(matu 8) ;>> >> 8

(ADVISE 'matu 'BEFORE '(PROGN
                        (PRIN1 '..before0:)
                        (TERPRI)))

(ADVISE 'matu 'BEFORE '(PROGN (PRIN1 '..before0:) (TERPRI)))

(advise 'matu '(PROGN (PRIN1 '..before1:) (TERPRI)))

(advise 'matu 'AFTER '(PROGN (PRIN1 '..after0:) (TERPRI)))

(ADVISE 'matu 'AFTER '(PROGN (PRIN1 '..after1:) (TERPRI)))

(ADVISE 'matu 'AROUND '(PROGN (PRIN1 '==>around0:) (TERPRI) * (PRIN1 '>==around0:) (TERPRI)))

(ADVISE 'matu 'AROUND '(PROGN (PRIN1 '==>around1:) (TERPRI) * (PRIN1 '>==around1:) (TERPRI)))

こんな感じにアドバイスをつけると、

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

こんな感じになります。
上記では、アドバイスの順番を指定していないですが、指定しない場合は、後に追加になります。
これは、(first top)/(last bottom end)で前後を指定可能になっています。

(DEFINEQ (zzz () (PRINT 'zzz)))

(ADVISE 'zzz 'BEFORE 'TOP '(PRINT 'hello1)) (ADVISE 'zzz 'BEFORE 'TOP '(PRINT 'hello2))

(zzz) ;>> hello2 ;>> hello1 ;>> zzz ;=> zzz

 面白いのが、関数内の関数にもアドバイスがかけられることで、

(DEFINEQ
  (foo () (PRIN1 'foo) (TERPRI))
  (bar () (PRIN1 'bar)(TERPRI))
  (baz () (PRIN1 'baz)(TERPRI))
  (makanito () (foo) (bar) (baz)))

 こんな感じの定義がある場合、

(ADVISE '((foo baz) IN makanito)
        'AROUND '(PROGN
                  (PRIN1 '>>)
                  (TERPRI)
                  *
                  (PRIN1 '<<)
                  (TERPRI)))

という定義で

(makanito)
;>> >>
;>> foo
;>> <<
;>> bar
;>> >>
;>> baz
;>> <<
;=> NIL

makanito内のfooとbazにアドバイスをかけることができます。
アドバイスの削除は、unadviseで、削除します。

(unadvise 'zzz)

まとめ

 今回は、interlisp: Advisingを紹介してみました。
上記のコード例を見てinterlispは標準状態の入力時でCommon Lispのようにcaseの変換をしないのに気付いたでしょうか。
大文字小文字はそのまま反映されるため標準関数は大文字で入力する必要があるということで、Common Lispでいうリードテーブルを:preserveモードにした時の挙動と同じということなんですが、一々大文字で入力しなくてもDWIM機能で対話的に修正してくれます(といっても面倒臭いですが)。
ただし、BEFORE、AFTER等の識別子は、DWIM機能が働いてくれなかったりするので気をつける必要があるみたいです。

Clozure CL: Static Variablesの紹介

Posted 2014-09-19 12:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の262日目です。

Clozure CL: Static Variablesとはなにか

 Clozure CL: Static Variablesは、Clozure CLの機能でスレッドの違いによらないグローバルな変数を実現するものです。

パッケージ情報

パッケージ名Clozure CL: Static Variables
参考サイトClozure CL: 4.8. Static Variables

インストール方法

 Clozure CL標準で提供されていて、CCLパッケージ内で定義されています。シンボルはエクスポートされていますが、cl-userには標準状態でインポートされています。

試してみる

 Clozure CLでのStatic Variableの定義は、スレッド間でも共通のグローバル変数で、束縛構文による束縛は禁止で代入しかできない変数です。
他の処理系だとLispマシンの時代から、大体defglobalとか、なんとか-globallyという名前で提供されています。

 提供されている機能は、マニュアルによるとdefstaticのみですが、兄弟にdefstaticvarというものもあるようです。
これらは、defparameterとdefvarの関係で、destaticvarの方がdefvarにあたります。

(defstatic **foo** 42)

(let ((**foo** 8)) **foo**) ;!> **FOO** is declared static and can not be bound

(setq **foo** 8) ;=> 8

(defvar **bar** 42)

(defstaticvar **bar** 84)

**bar** ;=> 42

 defstaticvarではdefvarのでの宣言のように未束縛のままにしておくというのができないのが謎ですが、何か理由があるのでしょうか。
ちなみに、処理系の実装を眺める限りでは、未束縛のStatic Variableは作ろうと思えば作れるようです。

(defvar **baz**)

(ccl::%symbol-bits '**baz** 20) ;20は、Static Variableのフラグ

(boundp '**baz**) ;=> NIL

(let ((**baz** 42)) **baz**) ;!> **BAZ** is declared static and can not be bound

まとめ

 今回は、Clozure CL: Static Variablesを紹介してみました。
Lispマシンにあった機能が脈々と受け継がれていたり、浮上してきたりするのは面白いところですね。

srfi-4-comprehensionsの紹介

Posted 2014-09-18 07:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の261日目です。

srfi-4-comprehensionsとはなにか

 srfi-4-comprehensionsは、Sebastian Egner氏作の単一型のベクタをSRFI 42で扱えるようにするためのライブラリです。

パッケージ情報

パッケージ名srfi-4-comprehensions
Chicken eggs:srfi-4-comprehensions - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install srfi-4-comprehensions

すれば、

(use srfi-42 srfi-4-comprehensions)

で使えます。

試してみる

 srfi-4-comprehensionsで拡張されているのは、vector-ecと、vector-of-length-ecです。
これらの動作は

(vector-ec (: e '#(1 2 3 4 5)) (* 2 e))
;=> #(2 4 6 8 10)

(vector-of-length-ec 5 (: e '#(1 2 3 4 5)) (* 2 e)) ;=> #(2 4 6 8 10)

みたいな感じですが、これらがそれぞれ、

  • s8vector
  • u8vector
  • s16vector
  • u16vector
  • s32vector
  • u32vector
  • s64vector
  • u64vector
  • f64vector
  • f32vector

の型ごとに定義されています。
動作は下記のようなところですが、vector-なんとか-ec のvectorは返り値の型のことなので、標準で定義されていないlistやvector以外は、入力でも別途指定する必要があります。

(u8vector-ec (: e '#(1 2 3 4 5)) (* 2 e))
;=> #u8(2 4 6 8 10)

(u8vector-ec (:u8vector e '#u8(1 2 3 4 5)) (* 2 e)) ;=> #u8(2 4 6 8 10)

(let* ((vec '#u8(1 2 3 4 5)) (len (u8vector-length vec))) (u8vector-of-length-ec len (:u8vector e vec) (* 2 e))) ;=> #u8(2 4 6 8 10)

 ちなみに、vector-ecとvector-of-length-ecの違いですが、前者がリストに出力してからベクタに変換するのに対して、後者は長さが与えられているのでベクタを作成して埋めていくので効率が良い、というところみたいです。

まとめ

 今回は、srfi-4-comprehensionsを紹介してみました。
型ごとに関数が別だと分かり易い反面、面倒臭いですね。

cartesian-product-switchの紹介

Posted 2014-09-17 07:45:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の260日目です。

cartesian-product-switchとはなにか

 cartesian-product-switchは、HexstreamことJean-Philippe Paradis氏のデカルト積的な分岐をする構文のライブラリです。

パッケージ情報

パッケージ名cartesian-product-switch
Quicklisp
プロジェクトサイトcartesian-product-switch: Hexstreamsoft
CLiKiCLiki: cartesian-product-switch
Quickdocscartesian-product-switch | Quickdocs
CL Test Grid: ビルド状況cartesian-product-switch | CL Test Grid

インストール方法

(ql:quickload :cartesian-product-switch)

試してみる

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

 名前からして大体想像が付く感じですが、こんな感じのマクロです。

(let ((x 1) (y 2) (z 3))
  (cp-switch:cartesian-product-switch ((case x 1 2 3)
                                       (case y 1 2 3)
                                       (case z 1 2 3))
    0 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 (t (error "~x = A, y = ~A, z = ~A" x y z)))) ;=> 5

これは、こんな感じに展開されます。

(BLOCK #:CARTESIAN-PRODUCT-SWITCH1424
  (TAGBODY
    (RETURN-FROM #:CARTESIAN-PRODUCT-SWITCH1424
      (ECASE
          (+ (* 9 (OR (CASE X (1 0) (2 1) (3 2)) (GO #:ELSE1425)))
             (* 3 (OR (CASE Y (1 0) (2 1) (3 2)) (GO #:ELSE1425)))
             (* 1 (OR (CASE Z (1 0) (2 1) (3 2)) (GO #:ELSE1425))))
        (0 0)
        (1 1)
        (2 2)
        (3 3)
        (4 4)
        (5 5)
        (6 6)
        (7 7)
        (8 8)
        (9 9)
        (10 10)
        (11 11)
        (12 12)
        (13 13)
        (14 14)
        (15 15)
        (16 16)
        (17 17)
        (18 18)
        (19 19)
        (20 20)
        (21 21)
        (22 22)
        (23 23)
        (24 24)
        (25 25)
        (26 26)))
   #:ELSE1425
    (RETURN-FROM #:CARTESIAN-PRODUCT-SWITCH1424
      (PROGN (ERROR "~x = A, y = ~A, z = ~A" X Y Z)))))

このcaseの部分を書き換えることによって他の構文もサポートしていますが、標準では

  • case
  • ccase
  • ecase
  • typecase
  • ctypecase
  • etypecase
  • if
  • cond
  • svref

がサポートされています。cp-switch:defineによってユーザーが定義することも可能とのこと。

まとめ

 今回は、cartesian-product-switchを紹介してみました。
一発物は紹介が楽で良いです。

serapeumの紹介

Posted 2014-09-16 14:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の259日目です。

serapeumとはなにか

 serapeumは、Paul M. Rodriguez氏作のユーティリティ集ですがAlexandriaと併用して使うことを意図しているものだそうです。

パッケージ情報

パッケージ名serapeum
Quicklisp
QuickdocsQuickdocs

インストール方法

(ql:quickload :serapeum)

試してみる

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

 定義されているユーティリティは下記のように結構沢山あります。
これらのシンボルは、alexandriaとは競合しないものが選択されているとのことで、一緒に:use :alexandria :serapeum できるとのことです。
リファレンスがあるので詳細はそちらを参照のこと。

  • *hook*
  • ->
  • @
  • add-hook
  • and-let*
  • append1
  • array-index-row-major
  • assocadr
  • assocdr
  • assort
  • batches
  • bcond
  • bestn
  • bits
  • blankp
  • bound-value
  • box
  • build-path
  • callf
  • callf2
  • car-safe
  • case-let
  • case-using
  • cdr-safe
  • check-the
  • class-name-safe
  • clear-queue
  • collapse-whitespace
  • collecting
  • comment
  • concat
  • cond-every
  • cond-let
  • date-leap-year-p
  • def
  • defalias
  • defcondition
  • defconst
  • defplace
  • defsubst
  • delete-file-if-exists
  • delq
  • deltas
  • deq
  • dict
  • dict*
  • distinct
  • drop
  • dsu-sort
  • dynamic-closure
  • ecase-let
  • econd
  • econd-failure
  • econd-let
  • efface
  • ellipsize
  • enq
  • ensure
  • ensure2
  • escape
  • eval-and-compile
  • example
  • expand-declaration
  • expand-macro
  • expand-macro-recursively
  • extrema
  • fbind
  • fbind*
  • fbindrec
  • fbindrec*
  • fdec
  • file-size
  • file=
  • filter
  • filter-map
  • finc
  • find-class-safe
  • find-keyword
  • firstn
  • flip
  • flip-hash-table
  • fmt
  • frequencies
  • front
  • gcp
  • gcs
  • get-unix-time
  • grow
  • growf
  • halves
  • hash-fold
  • hash-table-set
  • href
  • href-default
  • ignoring
  • in
  • inconsistent-graph
  • inconsistent-graph-constraints
  • intersperse
  • interval
  • invalid-number
  • invalid-number-reason
  • invalid-number-value
  • juxt
  • keep
  • leaf-map
  • leaf-walk
  • length<
  • length<=
  • length>
  • length>=
  • letrec
  • letrec*
  • letrec-restriction-violation
  • lines
  • longer
  • longest
  • lret
  • lret*
  • make
  • make-octet-vector
  • map-tree
  • mapcar-into
  • mapconcat
  • maphash-return
  • mapply
  • maybe-invoke-restart
  • memq
  • merge-tables
  • monitor
  • mvlet
  • mvlet*
  • nix
  • nlet
  • no
  • nor
  • nstring-invert-case
  • nstring-upcase-initials
  • nsubseq
  • nth-arg
  • nthrest
  • nub
  • occurs
  • occurs-if
  • octet
  • octet-vector
  • octet-vector-p
  • octets
  • op
  • ordering
  • parse-declarations
  • parse-float
  • parse-number
  • parse-positive-real-number
  • parse-real-number
  • partition
  • partition-declarations
  • partitions
  • plist-keys
  • plist-values
  • pop-assoc
  • pophash
  • powerset
  • prune
  • prune-if
  • qconc
  • qlen
  • qlist
  • queue
  • queue-empty-p
  • queuep
  • random-in-range
  • rassocar
  • remove-hook
  • round-to
  • run-hook-with-args
  • run-hook-with-args-until-failure
  • run-hook-with-args-until-success
  • run-hooks
  • runs
  • scan
  • select
  • selector
  • set-hash-table
  • shrink
  • shrinkf
  • single
  • slice
  • special-variable-p
  • split-sequence
  • split-sequence-if
  • split-sequence-if-not
  • standard/context
  • string$=
  • string*=
  • string-case
  • string-containsp
  • string-ecase
  • string-gensym
  • string-invert-case
  • string-prefixp
  • string-replace-all
  • string-suffixp
  • string-tokenp
  • string-upcase-initials
  • string^=
  • string~=
  • summing
  • swaphash
  • synchronized
  • take
  • throttle
  • time-since
  • time-until
  • tokens
  • toposort
  • trim-whitespace
  • unbits
  • unbox
  • undisplace-array
  • universal-to-unix
  • unix-to-universal
  • unoctets
  • unsplice
  • vect
  • vector=
  • walk-tree
  • whitespace
  • whitespacep
  • with-string
  • with-thunk
  • with-timing
  • words
  • write-stream-into-file
  • ~>
  • ~>>

 この中でfbindというのが面白そうなので、ちょっと試してみました。
これは(setf fdefinition)のローカル版という感じですが、LISP-2だとこれを実現するのはなかなか厄介です。
とりあえず、こんな感じで書けます。

(serapeum:fbind ((add1 (lambda (n) (+ 1 n))))
  (add1 8))
;=>  9

(serapeum:fbind ((add1 #'1+)) (add1 8)) ;=> 9

それぞれ

;==>
(LET ()
  (LET ()
    (FLET ((ADD1 (N)
             (+ 1 N)))
      (ADD1 8))))

;==> (LET () (LET ((#:ADD11318 (ALEXANDRIA:ENSURE-FUNCTION #'1+))) (DECLARE (FUNCTION #:ADD11318)) (FLET ((ADD1 (&REST SERAPEUM::ARGS) (DECLARE (DYNAMIC-EXTENT SERAPEUM::ARGS)) (APPLY #:ADD11318 SERAPEUM::ARGS))) (ADD1 8))))

こんな感じに展開されますが、fletに展開されるようです。
後者は、関数の情報を元に展開している訳ではないので、可変長引数として扱う他ないのかなと思いますが、やはりこういうのは処理系内部の機能を使わない限り効率の良いものを作るのは難しそうです。
とはいえ、前者のようにfletにきっちり嵌ると、

; disassembly for LATUMAPIC (assembled 11 bytes)
;        MOV EDX, 18                      ; no-arg-parsing entry point
;        MOV RSP, RBP
;        CLC
;        POP RBP
;        RET

のように定数を返す関数というところまで畳みこめたりはするようです。

まとめ

 今回は、serapeumを紹介してみました。
メジャーなユーティリティライブラリと併用する、というのはなかなか新しいスタイルですね。

foof-loopの紹介

Posted 2014-09-15 13:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の258日目です。

foof-loopとはなにか

 foof-loopは、Taylor R. Campbell氏作の繰り返し構文のマクロで、Chickenに移植されたものです。

パッケージ情報

パッケージ名foof-loop
Chicken eggs:foof-loop: A Simple, Extensible Scheme Looping Facility - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install foof-loop

すれば、

(use foof-loop)

で使えます。

試してみる

 Common LispのLOOPとnamed letとdoを足したような構文ですが、(末尾再帰でない)再帰で書いたり

(define (mapcar fn list)
  (loop rec ((for e (in-list list)))
        => '()
        (cons (fn e) (rec))))

お馴染のconsしてreverse!で書いたり、

(define (mapcar fn list)
  (loop ((for e (in-list list))
         (with ans '() (cons (fn e) ans)))
        => (reverse! ans)))

累積用の構文を使ったり

(define (mapcar fn list)
  (loop ((for e (in-list list))
         (for ans (listing (fn e))))
        => ans))

と色々できます。

 作者による詳しいドキュメンテーションとScheme48 Iterate、SRFI 42、Named let、DOとの比較があるので、詳しくはそちらを参照して下さい。

まとめ

 今回は、foof-loopを紹介してみました。
SRFI 42もCommon LispのLOOPっぽいですが、これもなかなかですね。

Older entries (233 remaining)