#:g1: frontpage

 

国会図書館デジタルコレクションとLisp

Posted 2022-05-31 00:04:36 GMT

今月19日より、国会図書館のデジタル化された資料のうち絶版等で入手困難なものに限ってインターネット経由で閲覧できるサービスが「個人向けデジタル化資料送信サービス」として開始したとのことで早速アカウント登録してみました。

登録には現住所が確認できる身分証が必要で現在のところ約一週間程度で本登録が完了するようです。

おもしろそうな資料

本登録完了前からめぼしいもののリストを作成してみていましたが、コンピュータ関係は歴史がまだ半世紀程度のため文学や音楽に比べると発掘できる資料も少ない印象を持ちました。

Lisp関係でいうと、1980年代の第二次AIブーム&エキスパートシステム関係の資料や、各社で出していた技術レポート、あたりが現在入手困難かつ閲覧可能なものでしょうか。残念ながらbitのようなコンピュータ誌は廃刊になったものを含めて本サービスの対象外のようです(国会図書館内でしか閲覧できません)

ということで、ざっと眺めてみて目についたものを列挙してみます。

まとめ

10年程前のプチLispブームの時の話ですが、「Lispは何も実用的なものを生み出したことがない。実用化されたことがない」などと放言する人をちらほら見掛けたりしました(現在でもたまにいるかも)。
当時のインターネットから検索できる資料では、ウェブが擡頭してくる以前の1980年代の資料は皆無に近く、国内の第二次AIブームやLispが関係してくるアプリケーションについての情報も手軽には入手できませんでしたが、国会図書館デジタルコレクションのお蔭で、上記の記事で取り上げたように金融や事務の業界でもニュースになったりはしていたという実態が手軽に確認できるようになってきました。
現在の第三次AIブームのDL/MLという手法/ツールとプログラミング言語のPythonに対応するものが、第二次ブームでのエキスパートシステムとLispとざっくり考えても外してはいないんじゃないかなあと思ったりです(ブームの規模は違えど)。

それはさておき、やはり、1980/90年代に刊行されていたComputer Todayのようなコンピュータ雑誌が閲覧できると嬉しいですねえ。


HTML generated by 3bmd in LispWorks 8.0.0

HyperSpecに登場するCommon Lisp処理系を集めてみた

Posted 2022-05-05 15:30:44 GMT

HyperSpecはANSI規格部分と規格成立までのイシューをまとめた部分とがありますが、イシューまとめ部には様々な処理系が登場します。
HyperSpec序文に登場する歴史的な処理系名と合せて、HyperSpecに登場する処理系をまとめてみました。

A-Lisp

  • バージョン: 未詳

ユタ大学で作成されていたStandard LispベースのCommon Lisp処理系のようですが詳細は不明です。ユタ大学の文献でたまに目にするような?

Austin Kyoto Common Lisp (AKCL)

  • バージョン: 未詳

オースティン大学でメンテナンスされていたKCLです。 後のGCLの元になりました。

Allegro Common Lisp

別名: Extended Common Lisp (ExCL)

  • バージョン: 3.1、3.1.beta.22、4.0、未詳

現在も健在のAllegro Common Lispです。

CMU Common Lisp

  • バージョン: 16d、未詳

現在も健在のCMUCLです。

Chesnut Lisp-to-C Translator

  • バージョン: 2.0、未詳

Common LispからCへのトランスレータです。主に組み込み用途だったようですが、CLtL2あたりの機能までカバーしていたようです。

  • https://github.com/binghe/chestnut

Golden Common Lisp

別名: GCLISP

Gold Hill社が1984年あたりから販売していた、Intel PC上で稼動したCommon Lispです。 フルセットのCommon Lispをサポートしたのは結構後(90年代)の様子。

  • http://www.goldhill-inc.com/developer.html

HP Common Lisp

別名: HPCL-I

HPが販売していた、Standard LispをベースにしたCommon Lisp処理系です。ユタ大学と共同開発していたようでエコシステムはPortable Standard Lispと共用だったりするようです。 後にHPは、Lucid社の処理系をOEM販売するようになるので、区別するためにIが付いていると思われます。

Ibuki Common Lisp

  • バージョン: Release 01/01、未詳

KCLを商用サポートで販売していたIbuki社の処理系

IIM Common Lisp

  • バージョン: 3.4、未詳

Integrated Inference Machinesが作製していたLispマシン上のCommon Lispです。 1986年のAAAIでお披露目されたようですが、殆ど情報がありません。 しかし、CLtL2相当の機能が実装されていた様子なのと、バージョンが3.4の記載があるので、地道に開発が進んでいたか、どこかで運用されていたのでしょうか。

Kyoto Common Lisp

  • バージョン: 3-Jun-87、9/16/86 on VAX、未詳

ご存知KCL。オブジェクトシステムは搭載していないのでCLtl1の機能についての話のみです。

Lambda Common Lisp

  • バージョン: 未詳

LMI Lambda上のCommon Lispです。実際の所Lambda CLと呼ばれていたのかは微妙ですが、LMIのドキュメントにちょっと記載があります。

Lucid Common Lisp

別名: Sun Common Lisp

  • バージョン: 2.0.3、2.1、2.1.3、3.0、3.0.1、4.0、4.0.0 Beta-1、4.1

Symbolicsと共に登場回数が非常に多いLucid CLです。
Lucid社はOEM戦略をとっていましたが、Sunのワークステーションとのセットがもっとも普及していた様子。
4.1というバージョンは倒産間際のバージョンですが、ANSI CL規格の成立とLucid社の倒産がほぼ同時期なのが無常です。

Macintosh Common Lisp

別名: Coral Common Lisp 別名: Macintosh Allegro Common Lisp (MACL)

  • バージョン: 1.1、1.2、1.2.2、2.0、2.0b3、2.0p1、2.0p2、未詳

Coral→Franz→Apple と渡り歩いたため名称の変遷があります。 現在のClozure CLのご先祖です。

NIL

序文に登場するのみです。

PSL/PCLS

PCLSは、Portable Common Lisp Subsetの頭字語です。 PSLとあるように、ユタ大学で開発されていました。

Poplog Common Lisp

サセックス大学で開発されていた、Poplogという様々な言語が動く環境上のCommon Lispです。
現在はバーミンガム大学で開発が続けられているようです。

  • https://www.cs.bham.ac.uk/research/projects/poplog/freepoplog.html

Symbolics CLOE

  • バージョン: 未詳

SymbolicsのLispマシンのアプリをIntel PC環境に出荷するための環境です。 Lispマシンは高価なので、開発はLispマシンで行ない、アプリは廉価な環境で実現するというニーズに応えたもの。 ちなみにCLOEだけでも、それなりに開発はできたようです。

S-1 Lisp

S-1スーパーコンピュータで稼動したCommon Lispの前身のような存在です。 NILのコードがベースになっている様子で、S-1 NILとも呼ばれます。

Spice Lisp

Common Lispのベースになった処理系の一つで、後にCommon Lisp化しました。 CMUCL、SBCLの祖先。

Symboics Common Lisp

別名: Genera

  • バージョン: 7、7.2、7.3、7.4、8.0、8.0.1、8.1、8.2、8.3、未詳

Symbolics LispマシンのGenera環境のCommon Lispです。 Symboics Common Lispという処理系名の筈ですが、Gereraと記載されていることが殆どです。 登場回数も非常に多く、Common Lisp規格にも結構な影響を与えていそうです。

TI Common Lisp

別名: Explorer

  • バージョン: release 6.0、未詳

テキサスインスツルメンツ社のLispマシン: TI Explorer上のCommon Lispです。
Sybolics Gereraもそうですが、処理系名よりシステム(OS)名で記載されているようです。

Utah Common Lisp

別名: UCL

ユタ大学のCommon Lispです。 Standard Lispベースのようで、HP Common Lispや、A-Lisp、PCLS等と関連が深いようです。

VAX LISP

  • バージョン: 2.2、未詳

DECのVAXで稼動したCommon Lispです。
商用処理系としては古参。

WCL

アプリのランタイムとして利用されることを主眼とした処理系です。

  • https://github.com/wadehennessey/wcl

Xerox Common Lisp

別名: Envos Medley

LispマシンのInterlisp-D上のCommon Lisp。後にEnvos社に譲渡されました。

まとめ

HyperSpecのイシューでしか目にしない処理系もあったりするのですが、規格の改善には人知れず役に立ったりしているような所が面白いですね。


HTML generated by 3bmd in LispWorks 8.0.0

Common Lispのスペースの行方

Posted 2022-04-28 03:52:44 GMT

こちらの記事を目にして、Qiitaの記事のタグcommon-lispや、Common LispCommonLispに名寄せするというのを知りました。 名寄せ自体は必要なことだと思うのですが、今回のQiitaでの対応は、スペースが含まれている名前は削除したものを最優先とするとのことです。

Qiitaのcommon-lispタグを作成したのは、実はQiitaのLispエントリー作成一番乗りだった私なのですが、

  • ANSI CL規格 ANSI INCITS 226-1994(S2018)での記述はCommon Lispになっている(空白なしは皆無)。
  • ハイフン繋ぎは、パッケージ名として使われているのである意味正式な表記:"COMMON-LISP"common-lisp
  • Stack Overflowでは、common-lispで統一されていた。

あたりを鑑みてcommon-lispを作成しました。 なんだかんだで、Stack Overflowに合せたというのが一番大きい気はしますが、既にcommon-lispというタグで統一して運用されていた感はありました。
ちなみに、Stack Overflow jaのcommon-lispタグ作成も私です(単なる一番乗り) また、各サイトに於けるタグ表記に使える文字の制限なのですが、空白や_-が使えたり使えなかったりするため、-を使って回避する、ということが多いようです。 なお、Zennも一番乗りだったのですが、-_も使えないため、CommonLispとなりました。

CommonLisp でも良いじゃないか

と思いますが、CommonLispって気持ち悪いんですよね。 また、ちゃんとした見識を持つ人が、CommonLispという表記を使うということはほぼない、というのも大きい気がします。

CommonLispと書く人の多くは、

  • 最近始めたばかり
  • 昔ちょっと触っていた
  • 独学でずっとやってきて他のCLerとやりとりをしたことがない

等の傾向がかなり高い印象なので、初学者の記事であったり、かなり偏った見識の記事であったりの指標のような存在に感じています。 ぶらさがり括弧のLispコードの親戚みたいなものでしょうか。

まとめ

Qiitaの件はCommonLispに向けて名寄せするということで、common-lispが廃止になったわけではありませんが、CommonLispを中心とすることで文化的にそっちに流れそうなのが嫌だなあという感じです。
せめて自分が愛好する言語の表記くらいは正しく表記したい。


HTML generated by 3bmd in LispWorks 8.0.0

Common Lispのデバッガを活用しよう (1)

Posted 2022-04-04 17:00:34 GMT

Common Lispでは通常、エラーが発生するとデバッガが起動してきて後続の処理をどうするかを訊ねられますが、個人的にはあまり活用できていないので、デバッガ活用方法を模索して行きたいところです。
今回は、初心にかえってデバッガの使い方を点検してみましょう。

デバッガを終了させる

Common Lispを始めてまず面喰うのが、「デバッガが起動してくること」そのものですが、処理系ごとにデバッガから抜けるコマンドが違っていたりして結構厄介です。
とはいえ、SLIME経由で使えばその辺りは統一したインターフェイスになり、q(uit)か、a(bort)を押下すればデバッガから抜けられます。
処理系が用意しているデバッガの場合は、トップレベルに抜けるコマンドが大抵:ret(urn)や、:topで、:a(bort)で該当のエラーから抜けます。

デバッガとコードを行ったり来たりする

デバッガを終了させることができれば、デバッガは起動してもすぐ閉じる、という運用が可能になります。
実質エラーの通知画面のような存在にすることも可能なのですが、それでは寂しいので、もう一歩踏み込んでみましょう。

下記のような欠陥があるコードを用意し、(a)を評価します。

(defun a ()
  (- (b)))

(defun b () (* (parse-integer (c)) 2))

(defun c () (elt '("x" "1") (random 3)))

エラー発生でデバッガ起動、

The index 2 is out of range for sequence ("x" "1").
   [Condition of type CONDITIONS:INDEX-OUT-OF-RANGE]

Restarts: 0: [RETRY] Retry SLIME interactive evaluation request. 1: [*ABORT] Return to SLIME's top level. 2: [ABORT] Quit process.

Backtrace: 0: (CONDITIONS::CONDITIONS-ERROR :INVISIBLEP T CONDITIONS:INDEX-OUT-OF-RANGE (:INDEX 2 :SEQUENCE ("x" "1") :DATUM 2 ...)) 1: (ERROR CONDITIONS:INDEX-OUT-OF-RANGE :INDEX 2 :SEQUENCE ("x" "1") ...) 2: (ELT ("x" "1") 2) 3: (B) 4: (A) 5: (SYSTEM::%INVOKE :INVISIBLEP T) 6: (SYSTEM::%EVAL (A)) 7: (EVAL (A)) 8: ((SUBFUNCTION 1 (SUBFUNCTION 1 SWANK:INTERACTIVE-EVAL))) --more--

とりあえずは、インデックスの範囲超過のエラーですが、エラー発生地点からトップレベルの方に向って一番近い自作の関数を確認します。
SLIMEのデバッガの表示では上から下に向って探してエラーから一番近い自作関数というと、(B)です。

(B)の上で、M-.(slime-edit-definition)するとソースコードにジャンプするので修正を検討します。

(defun b ()
  (* (parse-integer (c)) 2))

このコードには範囲超過のコードは含まれていないのでスキップだろうということで、自作関数の(c)を確認するため、M-.でソースに飛びます。

(defun c ()
  (elt '("0" "1") (random 3)))

(elt '("0" "1") (random 3))

がおかしいので、

(elt '("0" "1") (random 2))

に変更して、(c)を再コンパイルします(slime-compile-defun)

修正が済んだので、M-,(slime-pop-find-definition-stack)で戻ります。

(b)の定義に戻るので、更にM-,してデバッガ画面の、(b)の呼び出しの箇所(フレーム)に戻ります。 修正は終ったので、ここでrでフレームをリスタートします。

これで終了と思いきや、

No integer present in "x" from 0 to 1, parse-integer expected one.
   [Condition of type CONDITIONS::SIMPLE-PARSE-ERROR]

Restarts: 0: [RETRY] Retry SLIME interactive evaluation request. 1: [*ABORT] Return to SLIME's top level. 2: [ABORT] Quit process.

Backtrace: 0: (CONDITIONS::CONDITIONS-ERROR :INVISIBLEP T CONDITIONS::SIMPLE-PARSE-ERROR (:FORMAT-STRING "No integer present in ~S from ~D to ~D, parse-integer expected one." :FORMAT-ARGUMENTS ("x" 0 1))) 1: (ERROR CONDITIONS::SIMPLE-PARSE-ERROR :FORMAT-STRING "No integer present in ~S from ~D to ~D, parse-integer expected one." :FORMAT-ARGUMENTS ("x" 0 1)) 2: (B) 3: (A) 4: (SYSTEM::%INVOKE :INVISIBLEP T) 5: (SYSTEM::%EVAL (A)) 6: (EVAL (A)) 7: ((SUBFUNCTION 1 (SUBFUNCTION 1 SWANK:INTERACTIVE-EVAL))) --more--

となりました。 そういえば、パーズ対象は36進数の表現でした(そういうことにしましょう)ので修正します。

先程と同じく、(b)のフレームの上で、M-xし、定義に飛びます。
定義を、

(defun b ()
  (* (parse-integer (c) :radix 36.) 2))

のように修正し、M-,でデバッガに戻ります。 (b)のフレームの上で、rでリスタートすると、返戻値-66で正常に関数が終了しました。

まとめ

大体こんな感じのことを繰り返すことが多いのですが、今回の例でいうと(c)のフレームが見えていてくれれば、もっと簡単です。 この辺りは、SLIME経由でなく、処理系備え付けのデバッガであれば、表示してくれることもあります。

また、デバッグ設定の具合によって変化するので、デバッガを活用してみるということであれば、

(declaim (optimize (debug 3) (safety 3)))

あたりの設定で開発するのが吉かと思います。

また、処理系によっては手前のフレームからステップ実行したりすることもできます。 個人的にはステップ実行が便利に感じたことがあまりないので、エラーメッセージを良く読んで、ソースに飛ぶ位で十分かなという感じです。

今回の記事より深い内容はあまり知らないのですが、今後も便利な方法を模索してみたいと思います。

関連


HTML generated by 3bmd in LispWorks 8.0.0

S式は可読性が良い

Posted 2022-03-08 15:11:00 GMT

S式は可読性が良い/悪いというのは定期的に話題になりますが、大抵の場合Code is Dataという観点が抜けています。
LispにおいてCode is Dataというのは必須の要件であり、コードとしてのデータの読み書きの容易さ、把握のしやすさを考えずに可読性を議論してもしょうがないと思います。
逆にいうと、Code is Dataという観点が必要とされない言語がS式を採用する意味はあまりないと思いますし、Code is Dataという観点が必要とされない言語の感覚や価値観でS式を語ってもしょうがないと思います。大抵は、式のパーズが楽とかそういう話にしかなりません。

古くはM式→S式のMS変換に始まり、数式処理システム向けの中置記法などもあったり、DylanのようにAlgol文法の採用などもありますが、S式以外は、大体どれもコードとデータを行き来することになります。

  • メタ記述をデータに変換する方式: M式
  • パターンマッチ等でコードをデータのように扱う方式: Dylan
  • コードを中間形式に変換→コードに戻す: Julia

このような行き来をしないで一つの記法で済ませる方式がS式ですが、歴史的にはLisperは、M式→S式方式からS式に一本化することを選択したといって良いと思います。

Lisp編集では、エディタ上でもコード/データを操作する

Lispではデータでコードを記述しているので、エディタもリストデータを編集できれば良いということになります。リストと要素の操作に還元できるので、非常に操作感が統一されています。
コードの編集は、リストの要素を交換したり、追加したり、をすれば良いだけですが、S式以外の言語では、エディタが文法を理解している必要があり、大抵の場合はS式操作に比べればどこかに引っ掛かりがあります。 また、エディタ上でマクロの展開をしつつマクロを記述していったりしますが、マクロ記述/展開もまた単なるリスト操作であり、この辺りの記述とフィードバック情報の扱いやすさはS式ならではではないかと思います。

S式は、Code is Data、可読性、操作性、のバランスが絶妙なのです。


HTML generated by 3bmd in LispWorks 7.0.0

LEXPRの定義構文を作ってみよう

Posted 2022-03-04 03:03:07 GMT

特に何があったというわけでもないですが、lexprの構文が作りたくなったので作ってみました。
そもそも、LEXPRとは何かですが、引数をリストで受け取り中で分解して参照するような仕組みです。 MACLISP系統のMACLISP、Lisp machine Lisp、Franz Lispで使えますが、Common Lispが登場する頃にはより柔軟なλリストキーワードの方式が登場していたためか、可変長引数に対応するだけのLEXPRは取り入れられませんでした。

(defpackage lexpr
  (:use)
  (:export defun arg setarg listify))

(defmacro lexpr:defun (name argn &body body) (let ((args (gensym "args"))) `(defun ,name (&rest ,args &aux (,argn (length ,args))) (declare (ignorable ,argn)) (flet ((lexpr:arg (pos) (declare (type list ,args)) (elt ,args (1- pos))) (lexpr:setarg (pos val) (declare (type list ,args)) (setf (elt ,args (1- pos)) val)) (lexpr:listify (n) (if (minusp n) (last ,args (- n)) (subseq ,args 0 n)))) (declare (inline lexpr:arg lexpr:setarg lexpr:listify)) ,@body))))

argsetargの引数は1オリジンなので注意が必要

(lexpr:defun plus args
  (lexpr:setarg 1 (* 2 (lexpr:arg 1)))
  (lexpr:setarg 2 (* 2 (lexpr:arg 2)))
  (print (lexpr:listify -3))
  (+ (lexpr:arg 1) (lexpr:arg 2)))

(plus 1 1 1 2 2 2 2 'l 'a 's 't)
>> (a s t)
→ 4

(lexpr:defun print-no-of-arguments n
  (princ "Number of arguments supplied: ")
  (princ n)
  (terpri))

(print-no-of-arguments 'x 'y 'z)
>> Number of arguments supplied: 3
→ nil

(lexpr:defun power n
  (expt (lexpr:arg 1)
        (cond ((> n 1) (lexpr:arg 2))
              (T 2))))

(power 3)
→ 9

(power 3 4) → 81

まとめ

LEXPRの定義構文を真似てみました。 思えば、Unixのシェルスクリプトの$1$2あたりと似ていますね。


HTML generated by 3bmd in LispWorks 8.0.0

Common Lisp以外の言語でcl-benchを走らせてみる

Posted 2022-02-20 23:37:47 GMT

表題のとおりなのですが、cl-benchというCommon LispのベンチをCommon Lisp以外の言語で走らせて、Common Lispと比較するのも面白いかなと思ったので試してみました。

今回試したのは、GoDとCommon Lispの各処理系の比較ですが、全部移植するのも大変なので10種類程度の移植となっています。

言語をまたいでベンチをとってみての感想

まだ全部のベンチを移植して比較してみたわけではないので、第一感というところですが、

  • Lispらしい処理はCommon Lispが速いらしい(あたりまえか)

    • bignum
    • 有理数
    • リスト処理
  • Common Lispはインライン展開がいまいち効いていない(処理系ごとに癖があるので個別にチューニングが必要)

—あたりの印象をもちました。
インライン展開については、fibackermannあたりは関数呼び出しの速度比べですが、DやGoと同じ程度にインライン展開されるようにするには、結構書き方を調整しないと駄目だと思います。ちなみにD(dmd)のコンパイルオプションでは-inlineを付けていますが、つけない場合は結構遅くなります。

また、cl-benchには、型の指定や扱いがちぐはぐなコードがあったりもするなという印象です。
integerの配列と型指定しているのに、listオブジェクトを検索していたりしますが、コンパイラが賢ければnilに置き換えられてもおかしくなさそうです。
(なお、他の言語では要素の型を合せて比較しないと色々と面倒)

まとめ

あたり前ですが、今時の言語のGoなどは今時の処理に使われそうな処理が速いという印象です。 翻ってCommon Lispですが、やはり記号処理に強いのかなと思いました。
記号処理に強いCommon Lispというのを活かすのは、なかなか難しそうですが色々模索してみたいところです。
また、Common Lispと競合しそうなところで、Juliaあたりとも比較してみたいと思っています。

(2022-02-22 04:42) Juliaにも同様のものを移植し計測してみました。
(2022-02-23 16:55) Rustにも同様のものを移植し計測してみました。

ベンチ結果


HTML generated by 3bmd in LispWorks 8.0.0

暗黙のcond: コードウォーカー篇

Posted 2022-02-13 04:09:18 GMT

前回は、muLISPの暗黙のcondをリーダーマクロで再現してみましたが、コードウォーキングのお題としても使えそうな気がしたので、今回は暗黙のcondをコードウォーカーを使って再現してみたいと思います。

利用するコードウォーカーについて

今回利用するコードウォーカーはarnesiwalk-formです。
S式をパーズしてフォームのオブジェクトに変換し、それをアンパーズしてS式に戻す、という方式です。

変換の戦略としては、muLISPの暗黙のcondは、Common Lispの適用フォームとしては不正なので、これを検知して式を変換します。
具体的には、carにconsが来るのはlambda式の時のみなので、それ以外のconsのフォームを暗黙のcondと見做せば良さそうですが、arnesiでは、lambda式は既にlambda-application-formとしてハンドリングされているので、それ以外のfree-application-formの方にメソッドを定義します。

(ql:quickload '(alexandria arnesi))

(defpackage mu (:use) (:export defun))

(defun get-block-name (env) #+sbcl (caar (sb-c::lexenv-blocks env)) #+lispworks (caar (compiler::compiler-environment-benv env)))

(defmacro return-innermost (val &environment env) `(return-from ,(get-block-name env) ,val))

;;;((foo ...) ...) => (when (foo ...) ... (return-innermost ...)) (arnesi:defunwalker-handler arnesi:free-application-form (arnesi:operator arnesi:arguments) (typecase arnesi:operator (cons (destructuring-bind (pred &rest body) (call-next-method) `(when ,pred ,@(butlast body) (return-innermost ,@(last body))))) (atom (call-next-method))))

(defmacro mu:defun (name (&rest args) &body body) (multiple-value-bind (body decl doc) (alexandria:parse-body body :documentation T) `(defun ,name (,@args) ,@(if doc `(,doc) `()) ,@decl ,(arnesi:unwalk-form (arnesi:walk-form `(progn ,@body))))))

試してみる

(mu:defun fib (n)
  "fib"
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (declare (type fixnum n))
  (labels ((fib (n &aux n1 n2)
             ((< n 1) 0)
             ((< n 2) 1)
             (setq n1 (1- n))
             (setq n2 (- n 2))
             (+ (fib n1)
                 (fib n2))))
    (fib n)))
===>
(defun fib (n)
  "fib"
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (declare (type fixnum n))
  (progn
    (labels ((fib (n &aux n1 n2)
               (when (< n 1) (return-innermost 0))
               (when (< n 2) (return-innermost 1))
               (setq n1 (1- n))
               (setq n2 (- n 2))
               (+ (fib n1) (fib n2))))
      (fib n))))

(fib 40) → 102334155

(mu:defun fizzbuzz (n) (flet ((fizzp (n) ((zerop (rem n 3)) T) nil) (buzzp (n) ((zerop (rem n 5)) T) nil)) ((buzzp n) ((fizzp n) "fizzbuzz") "buzz") ((fizzp n) "fizz") n)) ===> (defun fizzbuzz (n) (progn (flet ((fizzp (n) (when (zerop (rem n 3)) (return-innermost t)) nil) (buzzp (n) (when (zerop (rem n 5)) (return-innermost t)) nil)) (when (buzzp n) (when (fizzp n) (return-innermost "fizzbuzz")) (return-innermost "buzz")) (when (fizzp n) (return-innermost "fizz")) n)))

(loop :for i :from 1 :repeat 100 :collect (fizzbuzz i))(1 2 "fizz" 4 "buzz" "fizz" 7 8 "fizz" "buzz" 11 "fizz" 13 14 "fizzbuzz" 16 17 "fizz" 19 "buzz" "fizz" 22 23 "fizz" "buzz" 26 "fizz" 28 29 "fizzbuzz" 31 32 "fizz" 34 "buzz" "fizz" 37 38 "fizz" "buzz" 41 "fizz" 43 44 "fizzbuzz" 46 47 "fizz" 49 "buzz" "fizz" 52 53 "fizz" "buzz" 56 "fizz" 58 59 "fizzbuzz" 61 62 "fizz" 64 "buzz" "fizz" 67 68 "fizz" "buzz" 71 "fizz" 73 74 "fizzbuzz" 76 77 "fizz" 79 "buzz" "fizz" 82 83 "fizz" "buzz" 86 "fizz" 88 89 "fizzbuzz" 91 92 "fizz" 94 "buzz" "fizz" 97 98 "fizz" "buzz")

まとめ

arnesiwalk-formを利用してmuLISPの暗黙のcondを再現してみました。
SBCLやLispWorksに付属のPCL系のwalk-formでも可能ですが、arnesiのものはカスタマイズしたい部分にメソッドを定義してやるだけなので簡潔かと思います。
ただし、今回のような定義では、arnesiunwalk-form全体に影響を及ぼしてしまうので、フォームオブジェクトをサブクラス化してカスタマイズに使う等の工夫が必要になるかと思います。


HTML generated by 3bmd in LispWorks 7.0.0

暗黙のcond

Posted 2022-02-07 20:04:22 GMT

muLISPの本をながめていたところ、どうも見慣れないカッコの連続が目につくので、詳細を確認したのですが、muLISPではprognなどのボディ部でcondの省略形が使えるようです。
いわば暗黙のcondという感じなのですが、詳細な情報を求めてマニュアルを確認すると、これはマクロや式変換ではなく評価器レベルで実現している機能のようです。

などと文字で書いても判りづらいのでコード例で示しますが、Common Lispで書くと、

(defun fib (n)
  (cond ((< n 1) 0)
        ((< n 2) 1)
        (T (+ (fib n1)
              (fib n2)))))

のようになるものが、muLISPでは

(defun fib (n)
  ((< n 1) 0)
  ((< n 2) 1)
  (+ (fib n1)
     (fib n2)))

のように書けるようです。またprogncondにそのまま置き換わった形式でもないようで、任意の節を述語部の間に挟むことが可能です。

(defun fib (n)
  ((< n 1) 0)
  (print n)
  ((< n 2) 1)
  (print n)
  (+ (fib n1)
     (fib n2)))

暗黙のcondをCommon Lispで真似してみる

そもそも元が評価器レベルで実現しているので、これをマクロで実現するのは手間が掛かる割には上手くいかなさそうです。
今回は妥協してリーダーマクロで実現してみることにしました。

(defun get-block-name (env)
  #+sbcl (caar (sb-c::lexenv-blocks env))
  #+lispworks (caar (compiler::compiler-environment-benv env)))

(defmacro return-innermost (val &environment env) `(return-from ,(get-block-name env) ,val))

(set-syntax-from-char #\] #\))

(set-macro-character #\[ (lambda (srm chr) (declare (ignore chr)) `(if ,(read srm T nil T) (return-innermost ,(cons 'progn (read-delimited-list #\] srm T))))))

ブラケットで囲んだ場合にmuLISPのような挙動となりますが、まあ使い勝手の確認はできそうです。

(defun fib (n)
  "fib"
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (declare (type fixnum n))
  (labels ((fib (n &aux n1 n2)
             [(< n 1) 0]
             [(< n 2) 1]
             (setq n1 (1- n))
             (setq n2 (- n 2))
             (+ (fib n1)
                (fib n2))))
    (fib n)))

(fib 40) → 102334155

まとめ

muLISPの暗黙のcondを再現してみました。
muLISPは1980年代にパソコン用LISPとして結構普及していたようですが、MACLISP系の文法を採用している割には意外な拡張をしていたみたいですね。


HTML generated by 3bmd in LispWorks 8.0.0

LispWorks 8.0のエディタでの日本語入力がおかしい件

Posted 2022-01-22 11:29:27 GMT

先日のLispWorks 8.0 Linux版の評価でもちょっと書きましたが、LispWorks 8.0ではエディタバッファでの日本語入力が場合によっては使い物にならない挙動のようです。

先日試したのはLinux版だったのでGTk版特有の挙動かと考えLispWorksにもそのように報告しましたが、macOS版でも同じような挙動を確認しました。
しかしこれがなんとも説明しがたい挙動なので動画にしてみました。

LispWorks 7.1 Personal editionでのIMEのインライン変換(正常)

LispWorks 8.0 でのIMEのインライン変換(おかしい)

症状としてはバッファの先頭か末尾に入力する分にはそこまで変でもないですが、それ以外の場所に文字を挿入しようとすると変換選択の画面が画面先頭にでたり、さらにその表示のゴミがのこったりするようです。
GTk版では変換候補の画面が一切出てこないためゴミもバッファに挿入されません。
LispWorksのエディタだけでなくGUIのツールキットのeditor-paneも同様の症状です(まあ同じクラスだから当たり前か……。)
自分は確認していないのでなんともいえませんがeditor-paneがおかしいのでWindows版も同様ではないでしょうか。

日本語入力をさせるアプリを作っている方で、LispWorks 8.0の購入を考えている方は、ちょっと様子を見た方が良いかもしれません。
一応バグ報告をしているので修正されることを期待していますが、LispWorksのメーリングリストでも騒いでいる人はいまのところいません。
IMEを使う文化圏のユーザーは少数派でしょうから、このバグの修正もそんなに期待できないかもしれませんねえ……。

Lispエディタの問題だけならまだ良いのですが、作成したアプリでeditor-paneを使った場合、日本語の入力がまともに機能しなくなるのが痛いですね。


HTML generated by 3bmd in LispWorks 8.0.0

Lispコミュニティを考える: Shibuya.lisp発足以前の日本のLispコミュニティ

Posted 2022-01-18 19:28:17 GMT

前回はは、Lisp方言と愛好者のバックボーンを分類して適当なことを考えたりしてみましたが、今回はShibuya.lispが発足した2008年より前のLispコミュニティについてこれまで調べていたことをざっとまとめてみたいと思います。  

Shibuya.lisp以前

そもそも最近のフリーソフトウェアを中心としたコンピューター言語の集まりのようなものが盛んになり始めたのはオープンソースムーブメントが活発化してきた2000年代初頭からかと思います。   Shibuya.lispは元々Shibuya.pmというPerlコミュニティの集いのLisp版として企画されたようです(higepon氏によって)が、2000年代中頃からは勉強会ブームが到来したりと、プログラミング言語とコミュニティの関係が結構熱かった時期だったなと思います。
このあたりのことをどこかで書いたことがあった記憶があったのですが、このブログに一度まとめていたみたいです。

2000年代以前

さて、オープンソースムーブメント以前からLispは存在するわけですが、2000年以前はどんなことになっていたのかというと、オープンソースの草の根コミュニティという形態よりは、どこかの企業がイベントを開催し、そこに愛好者が集うという形式が多かったようです。
具体的な例を挙げると、数理システムが1990年代後半にセミナーを開いたりしていた様子。

また、アカデミックな方面では、後藤英一先生の呼びかけで始まった 情報処理学会 記号処理研究会 というものが1977年から1995年あたりまで年四回位のペースで続いていたようです。

また、1980年代後半には、Common Lispを中心とした商業ベースのイベントなどもあったようですし、日本シンボリックスを筆頭として、有償でのLispセミナーのようなものが月一程度で開催されていたようです。

詳しくは日本のLispイベントを一覧にまとめていますので興味のある方は眺めてみてください。

なお、この一覧では1990年代後半のイベントを集めることができていません。このあたりで一つの時代が消滅しているような雰囲気もありますが、ウェブに記録があまり残っていない時代でもあるため実際のところどうだったのか詳しく知りたいところではあります。

まとめ

日本のLispコミュニティについて1970年代あたりからざっと眺めてみました。
大体のところは、

  • 1970年代: コンピュータ言語研究者の集い
  • 1980年代: AI/エキスパートシステム実用化に伴いベンダーがセミナーやイベントを主催
  • 1990年代: ほぼ暗黒期
  • 2000年代: オープンソースムーブメントやPerl、Ruby等LLの盛り上がりに乗じてLispも盛り上がってみる
  • 2010年代: 言語ブーム沈静化、第三次AIブームと、それとはほぼ無縁なLisp
  • 2020年代: プログラミングスクールブームと、それとはほぼ無縁なLisp

というところでしょうか


HTML generated by 3bmd in LispWorks 7.1.3

手抜きでwith-added-methodsを実装してみる

Posted 2022-01-16 17:11:34 GMT

with-added-methodsは提案されたもののANSI CLには採用されなかったローカルな総称関数の構文で、現在は、ANSI CL規格の中間報告書であるCLtL2には痕跡を残すのみとなっています。

ローカルな総称関数の構文としては、with-added-methods以外にも、lambdaに相当するgeneric-functionflet/labelsに相当するgeneric-flet/generic-labels、とありますが、with-added-methodsだけは、既存の関数の構文には相当するものが存在しません。

数年に一度程度の割合で、ローカルな総称関数という恐しい構文がCommon Lispに存在したという文脈でgeneric-flet/labelsが紹介されることがあるのですが、多分、話題にしている人が想定しているのは、with-added-methodsの方ではないかなと推測しています。というのも、with-added-methods以外は既存の総称関数を拡張するものではなく、局所的に一時的な新しい総称関数を定義するだけなので、flet/labelsと大した違いはありません。

下記はどんな風な構文だったかを試してみるための手抜きのgeneric-系の実装です。どの辺りが手抜きかというと、コンパイルしないとまともな速度で動かない点と、load-time-valueを使っているため周囲の変数環境等を取り込めないところです。
ちなみに、現在使われている処理系でgeneric-系のローカルな総称関数構文をサポートしているのはCLISPのみですが、過去にはSymbolics CLや、MCLが実装していたことがあったようです。

(defpackage "e95807a5-c970-5e32-82b6-328d307de616" 
  (:use c2cl)
  (:shadow generic-function))

(in-package "e95807a5-c970-5e32-82b6-328d307de616")

(deftype generic-function (&rest args) `(cl:generic-function ,@args))

(defmacro generic-function ((&rest args) &body body &environment env) (let ((gf (gensym "anonymous-generic-function-"))) `(load-time-value (defgeneric ,gf (,@args) ,@body))))

(defmacro generic-flet ((&rest local-gfs) &body body) `(flet (,@(mapcar (lambda (gf) (destructuring-bind (name args &body body) gf (let ((gf (gensym "anonymous-generic-function-")) (lf-args (gensym "args"))) `(,name (&rest ,lf-args) (declare (dynamic-extent ,lf-args)) (apply (load-time-value (defgeneric ,gf (,@args) ,@body)) ,lf-args))))) local-gfs)) ,@body))

(defmacro generic-labels ((&rest local-gfs) &body body) `(labels (,@(mapcar (lambda (gf) (destructuring-bind (name args &body body) gf (let ((gf (gensym "anonymous-generic-function-")) (lf-args (gensym "args"))) `(,name (&rest ,lf-args) (declare (dynamic-extent ,lf-args)) (apply (load-time-value (defgeneric ,gf (,@args) ,@body)) ,lf-args))))) local-gfs)) ,@body))

(mapcar (generic-function (x y)
          (:method ((x cons) (y cons))
           (append x y))
          (:method ((x number) (y number))
           (+ x y))
          (:method (x y)
           (list x y)))
        '(42 (0 1 2 3) z)
        '(42 (0 1 2 3) z))(84 (0 1 2 3 0 1 2 3) (z z)) 

(generic-flet ((plus (x y) (:method ((x cons) (y cons)) (append x y)) (:method ((x number) (y number)) (+ x y)) (:method (x y) (list x y)))) (list (plus 8 8) (plus '(1 2 3 4) '(1 2 3 4)) (plus 'z 'z)))(16 (1 2 3 4 1 2 3 4) (z z))

;; ローカルの関数を参照できないので引数で渡す必要がある(labelsとは……) (defun fibonacci (n) (generic-labels ((%fib (n fib) (:method ((n (eql 0)) fib) 0) (:method ((n (eql 1)) fib) 1) (:method ((n integer) fib) (+ (funcall fib (1- n) fib) (funcall fib (- n 2) fib))))) (%fib n #'%fib)))

(fibonacci 40) → 102334155

with-added-methods

さて今回の主題のwith-added-methodsですが、大体の仕様な下記のようなものです

  • 既存の総称関数がなければ、generic-labelと似たような挙動
  • 既存の総称関数があれば、その総称関数をコピーし、with-added-methodsで定義されたメソッドを加えて実行する
  • 既存の総称関数がないが関数定義がある場合は、その関数をデフォルトメソッドとした総称関数を定義してメソッドも追加

今回改めて確認するまで、この構文は、既存の総称関数に破壊的にメソッドを足して構文を抜けたら戻すものだと記憶していたのですが、破壊的に変更するのではなくコピーをするようです。しかしそうすると再帰しているような場合はどうなるのでしょう……。

具体的に考えると、

(defgeneric fib (n)
  (:method ((n (eql 0))) 0)
  (:method ((n (eql 1))) 1)
  (:method ((n integer)) 
   (+ (fib (1- n))
      (fib (- n 2)))))

のような定義があった場合に、with-added-methodsfib(5)=5のような定義を足してみる場合、

(with-added-methods (fib (n fib)
                      (:method ((n (eql 5)) fib) 
                       5))
  (fib 40))

となるわけですが、新しく足したメソッドは再帰していないので良いとしても、再帰しているfib integerが内部で呼び出すメソッドもローカルのfibにならないと大域のfibの方に逃げていってしまいます。
これはメソッドのソースコードを保持していれば式を全部展開して総称関数を組み立て直すことで実現できそうではあります。しかしこの方法も大域のメソッドの方がレキシカルな自由変数を取り込んでいる場合に復元できないので、環境も記憶しておく必要があります……。

等々色々問題があるのですが、あまり深追いせずに適当に手抜きで作成してみました。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun method-description-p (form)
    (typep form '(cons (eql :method) *))))

(defun copy-generic-function (name gf &key generic-function-class lambda-list declare method-combination method-class argument-precedence-order) (let ((newgf (etypecase gf (GENERIC-FUNCTION (setq generic-function-class (class-of gf)) (setq lambda-list (generic-function-lambda-list gf)) (setq declare (generic-function-declarations gf)) (setq method-combination (generic-function-method-combination gf)) (setq method-class (generic-function-method-class gf)) (setq argument-precedence-order (generic-function-argument-precedence-order gf)) (ensure-generic-function name :generic-function-class generic-function-class :lambda-list lambda-list :declare declare :method-combination method-combination :method-class method-class :method-combination method-combination :argument-precedence-order argument-precedence-order)) (FUNCTION (let ((gf-from-fn (ensure-generic-function name :lambda-list (lw:function-lambda-list gf)))) (add-method gf-from-fn (make-instance 'standard-method :function (lambda (&rest args) (declare (ignore next)) (apply gf args)) :lambda-list (lw:function-lambda-list gf) :specializers (mapcar (constantly (find-class T)) (lw:function-lambda-list gf)))) gf-from-fn)) (NULL (ensure-generic-function name :lambda-list lambda-list))))) (when (typep gf 'generic-function) (dolist (m (generic-function-methods gf)) (add-method newgf (make-instance (generic-function-method-class newgf) :function (method-function m) :lambda-list (method-lambda-list m) :specializers (method-specializers m)))))

newgf))

(defmacro with-added-methods ((function-name lambda-list &rest method-description/option) &body body) `(labels ((,function-name (&rest args) (apply (load-time-value ,(let ((name (gensym "gf"))) `(let ((,name (copy-generic-function ',name ,(if (fboundp function-name) `#',function-name nil) :lambda-list ',lambda-list ,@(remove-if #'method-description-p method-description/option)))) ,@(mapcar (lambda (mf) `(defmethod ,name ,@(cdr mf))) (remove-if-not #'method-description-p method-description/option)) ,name))) args))) ,@body))

試してみる

とりあえず、再帰はうまく扱えないので引数経由で自身を渡すことにします。

(defgeneric fib (n fib)
  (:method ((n (eql 0)) fib) 0)
  (:method ((n (eql 1)) fib) 1)
  (:method ((n integer) fib) 
   (+ (funcall fib (1- n) fib)
      (funcall fib (- n 2) fib))))

とりあえず素のfib

(time (fib 40 #'fib))
Timing the evaluation of (fib 40 #'fib)

User time = 6.907 System time = 0.109 Elapsed time = 6.933 Allocation = 170288 bytes 3995 Page faults 102334155

コンパイルしないと異様に遅い

(time
 (with-added-methods (fib (n fib)
                          (:method ((n (eql 5)) fib) 
                           5))
   (fib 20 #'fib)))

Timing the evaluation of (with-added-methods (fib (n fib) (:method ((n (eql 5)) fib) 5)) (fib 20 #'fib))

User time = 1.365 System time = 1.672 Elapsed time = 3.077 Allocation = 132662416 bytes 226350 Page faults Calls to %EVAL 368057 6765

コンパイルすればどうにか早くなる

(defun foo-fib (n)
  (with-added-methods (fib (n fib)
                        (:method ((n (eql 5)) fib) 5))
    (fib n #'fib)))

(time (foo-fib 40)) Timing the evaluation of (foo-fib 40)

User time = 4.069 System time = 0.084 Elapsed time = 4.075 Allocation = 160912 bytes 4005 Page faults 102334155

通常の関数をローカルでは総称関数のデフォルトメソッドとして扱い、さらにメソッドを足す

(defun foo (x) x)

(foo 0) → 0

(with-added-methods (foo (x) (:method ((x (eql 'foo))) '(foo !))) (foo 'foo))(foo !)

まとめ

以上、謎の多いwith-added-methodを手抜き実装しつつ紹介してみました。
仕様がまとめられず没になったのも頷ける気がしますが、割合に使いどころはありそうな構文な気もしました。


HTML generated by 3bmd in LispWorks 7.1.3

macOSでc-m-Qが「画面をロック」のショートカットになっているのを解除する

Posted 2022-01-13 04:39:09 GMT

Emacs系エディタでLispを編集している場合、S式を整形するのにControl-Meta-Q(indent-pp-sexpIndent Form)を使うと思うのですが最近のmacOSではログアウトのショートカットになっているのでこれを阻止しないと安心してS式編集ができません。

新しいmacOS環境を構築する度に毎度調べているのでブログにメモしておきます。

具体的な方法はこちらの記事に詳しいですが、日本語メニューの場合、指定する文言が違い、「画面をロック」とする必要があります。

手順

システム環境設定 > キーボード > ショートカット > アプリケーション

と進み+でアプリケーション「全アプリケーション」でメニュータイトル「画面をロック」を追加し、c-m-Q以外のショートカットを登録し「追加」することで、動作が上書きされます。

まとめ

macOSでのEmacs系エディタでのc-m-Q問題の回避方法をメモしてみました。
ウェブを検索してもEmacsの問題としてはヒットしないのですが皆さんc-m-Qじゃなくて別のキーバインドを使ってるんですかね?(c-m-\とか)


HTML generated by 3bmd in LispWorks 7.1.3

Lispコミュニティを考える: Lispコミュニティと一括りにするが

Posted 2022-01-09 00:40:04 GMT

Shibuya.lisp Tech Talkが久々に開催されるとのことで、Shibuya.lispの初期の歴史について話ことになってしまったのですが、うまく喋れる気が全くしないので話が空中分解して意味不明な話になった場合の予防処置をしておきたいということで、Shibuya.lispを中心として私が考察したLispコミュニティというものをまとめておきたいと思います。

マイナーコミュニティなのに消滅しない理由を考える

マイナーコミュニティ全般にいえますが、参加者が0になれば消滅することになります。
実際には増えたり減ったり消滅したり再生したりを繰り返していますが、これらは何種類かに分類できるかと思います。
これを参加者のバックボーンと呼んで分類してみましょう。

業務バックボーン

  • 基本的に仕事のプロジェクトがなくなればサヨナラ

業務で携わることになった人達です。
いまどきだとClojureの人達は割合にこのあたりに該当するかと思います。
古くはCommon Lispに多かったと思いますが、昔のLispを懐しむけれど今はLispを書いていないようなプログラマはこの辺りに属するかと思います。
ありがちなセリフ『本物のマクロが恋しいよ』、『機会があれば書きたい』、『Lispで飯が食えるのか』

研究者バックボーン

  • 息は長いが研究テーマから離れればサヨナラ

研究者の方は息が長いのが特徴です。
息の長い研究者コミュニティというバックボーンが別途あり、その運用方法なども確立されているようにみえます。
Lisp/Schemeでいえば、1980年台に活躍されていた先生方はこの辺りに属しているかと思います。
たまに世間でブームになったときに里におりてくるようなところがあります。

愛好者バックボーン

  • 根強い

愛好者にも色々ありますが、処理系作成と、Common Lispのようにアプリ寄りの人達がいます。
マイナージャンル故、教えてくれる人が身近におらず独学者が多いので書籍の影響が異様に強いのが特徴かと思います。
その為か、実際にコミュニティでコードを書いている人達より、Paul Grahamのような有名なハッカーや、著者の先生の思想に影響を受けています。
ネタ元自体がそれ程多くない故、どの本の受け売りなのかネタ元が特定できますが、書籍の情報はどんどん古くなるため、古い知識が再生産される源泉にもなっています(Lispはインタプリタだから遅い説など)

なぜLispで一括りにされるのか

なぜLispで一括りにされるのか不思議に思っていましたが、もしかするとLispの登場が古い故にトピックの分類や棲み分け自体も古い形式を引き継いでいるからかもしれません。
例えば、C系統の言語は、分派それぞれでコミュニティを作りますが、Lispは『方言』としてLispとしてまとまる傾向があります。
Lisp、Algol、Fortranが登場したばかりの1960年代では、『方言』という括りで、主に実装者や研究者がその傘下に集っていたようですが、時代が下ると『方言』より細かい個別の言語でコミュニティを形成するようになり、言語を横断するような概念に関しては、『○○パラダイム』や『△△指向言語』として別途横断的なコミュニティを形成するようになったように見受けられます。

Lispではコミュニティにおける処理系作成者の比率が高いということもあり、自身が開発した処理系をLisp『方言』と考え、方言が集まったLispコミュニティを想定する方がしっくりくということもあるのかもしれません。

Common Lispや、Clojureでは処理系よりアプリへの関心が主なのでLisp方言という括りに関心がある人は多くはありません。特にClojureは個別にまとまる傾向が強いと感じます。

Lisp方言とバックボーン

さて、バックボーンを説明したので、方言とバックボーンの関係を考えてみたいと思います。
また、再生と消滅を繰り返しているので、再生の火口になっていると考えられるものも併記してみます。

Common Lisp

  • 愛好者+業務バックボーン→フリーランサー

日本でも海外でも一匹狼の集団といわれることが多いCommon Lispの人達です。
Lisp熱が昂じた結果、業務プレイヤーがLispプログラマとしてフリーランサーとなったような人は良く見掛けます。

  • 再生するために必要なもの: 情熱、業務で使えるクオリティの処理系

Clojure

  • 業務バックボーン+愛好者→業務プレイヤー

Common Lispの人達程世の中の流れに抗っている感じはなく、割と時流に乗っているようにみえます。
Java資産に乗っかっているようなところも程良いバランスを保てているところかもしれません。

  • 再生するために必要なもの: 職場

Scheme

  • 研究者+愛好者→処理系製作者

実際に職場でSchemeを採用して複数名で開発をしている、というのはCommon Lisp以上に見掛けません(個人的には皆無)。
最近ではプログラミング言語の研究テーマ抽象的なトピックが多いようで特定の言語でどうこうというのは下火のようです。アカデミック寄りのRacketは教育を主軸にしているように見えます。
SRFIを含めたSchemeコミュニティを概観すると、Schemeの仕様を中心とした処理系製作者コミュニティという趣があります。

  • 再生するために必要なもの: 仕様、自作処理系、研究発表

まとめ

なぜLispとして一括りにされるのか、Lispとコミュニティ、等について考察してみました。
個人的にはLispとして一括りにするのは、オブジェクト指向言語全般で一括りにするのと大体似たようなものだなと思ったりです。


HTML generated by 3bmd in LispWorks 8.0.0

VAX LISPのFFIを試してみる

Posted 2022-01-03 21:17:23 GMT

こちらのツイートを目にして、そういえばVAX LISPのFFIって試したことがなかったので、この機会に試してみることにしました。

試したのは、紹介されているbit誌のコードで、試した処理系はLiving Computersに設置されているVAX-7000/640上のVAX LISP 3.1です。

まず、Cのコードを作成、

#include <stdio.h>

be_good (times, string)
int times;
char string[];
{
int count;
for (count=0; count < times; count++)
    printf ("%s, I must not be so.\n", string);
printf("\n");
return(times);
}

$ cc be_good.c

$ link/shareable=[user.masso]be_good be_good,sys$input:/option #改行 universal=be_good #^Zで完了

VAX LISPを起動し下記を定義

(define-external-routine (be-good :image-name "be_good" :entry-point "be_good" :result integer)
  (times :lisp-type integer :mechanism :value)
  (person :lisp-type string :vax-type :asciz))

call-outで実行してみる

Lisp> (call-out be-good 10 "Daddy")
Error in SYSTEM::%SP-CALL-OUT:
%LIB-E-ACTIMAGE, error activating image SCSI$DIA0:[SYS0.SYSCOMMON.][SYSLIB]BE_GOOD.EXE;
-RMS-E-FNF, file not found

Control Stack Debugger Eval #10: (SYSTEM::%SP-CALL-OUT 10 "Daddy" 2 #:G556)

どうもBE_GOOD.EXEの場所を見付けてくれない様子……。
ファイルの絶対パス指定等を試してみましたが、解明すべき謎が多すぎるので諦めました。

下記のようなマニュアルの他の例は動くようなのでファイルの場所さえ適切に指定できれば動きそうではあります。

(define-external-routine (put-screen :image-name "scrshr"
                                     :entry-point "lib$put_screen"
                                     :result integer)
  (chars :lisp-type string)
  (line :lisp-type integer
        :vax-type :word)
  (col :lisp-type integer
       :vax-type :word)
  (flag :lisp-type integer
        :vax-type :word))

cffiで同じ例を試してみる

このままでは若干寂しいのでcffiで同じ例を試して比較してみることにしました。

#include <stdio.h>

int be_good (int times, char string[])
{
  for (int count = 0; count < times; count++)
    printf ("%s, I must not be so.\n", string);
  printf("\n");
  return(times);
}

lib-be-good.cとして用意し、

gcc -shared be_good.c -o lib-be-good.so

(ql:quickload "cffi")

(defpackage "2657427c-2fcb-5f17-abc2-5439545b51fa" (:use "CL" "CFFI"))

(in-package "2657427c-2fcb-5f17-abc2-5439545b51fa")

(define-foreign-library lib-be-good (T (:default "lib-be-good")))

(use-foreign-library lib-be-good)

と定義。
VAX LISPのcall-outに相当しそうな、foreign-funcallで呼び出してみると、

(with-foreign-string (person "Daddy")
  (foreign-funcall "be_good":int 10 :string person 
                   :int))

Daddy, I must not be so.
Daddy, I must not be so.
Daddy, I must not be so.
Daddy, I must not be so.
Daddy, I must not be so.
Daddy, I must not be so.
Daddy, I must not be so.
Daddy, I must not be so.
Daddy, I must not be so.
Daddy, I must not be so.

という風にできました。
with-foreign-stringは無しでも動きますが、一応メモリ周りの処理をしてくれるので利用しています。

まとめ

VMSでは、Common Language Environmentという言語間で共通の呼出規約が定められていたようで、色々な言語を簡単に混ぜて使えたようです。
マニュアルでもFortranのコードを呼び出す例が紹介されていたりしますが、共通の形式になるので呼び出す側からは元の言語はあまり意識しなくて良い様子です。


HTML generated by 3bmd in LispWorks 8.0.0

ツリーシェイキングも楽ではない

Posted 2022-01-02 20:04:51 GMT

最近はさほど言われることもなくなりましたが、以前は、Common Lisp処理系は実行可能ファイル(exe)が作れないので使えない、という人が割合にいました。
また、実行可能ファイルが生成できたとしても、フリーソフトのCommon Lisp処理系はファイルサイズについての最適化はそれ程頑張っていないので、非常に巨大なため、これでは使えない、といわれていました。
とはいえ、スマホアプリが100MiBを越えることもざらな近頃では大して話題にならなくなってきたみたいではあります。

この実行可能ファイルのサイズを小さく最適化したいという需要に応えるものとして、1980年代からツリーシェイカーというものがありました。
これは、Lispのイメージ中の不要なものを出荷するイメージから篩い落すというものですが、昔から商用の処理系には装備されており、今でもLispWorksや、Allegro CLにはそのような機能があります。
ちなみに、MCLではメモリが128KiBのような時代から存在していて実用的なサイズで出荷できていたようですし、Lucid CLでも同様だったようです。

そんなツリーシェイカーですが、開発環境でアプリを作って、あまり考えずに出荷時の最適化を掛け過ぎると、実行環境で必要なものまで落ちてしまいます。
そうなると、開発時から無用なライブラリはできるだけ使わないように調整したり、出荷時に確認して削ぎ落すわけですが、これが案外面倒なので、最近自分は、大きいサイズのままでも良いや、という風に割り切っています。
折角の機能なので活用したいところではあるのですが……。

ちなみにイメージサイズを縮小するのとは別のアプローチとして、OSのホスト言語(C等)を生成し、それをビルドして実行可能ファイルを生成するものがあります(ECL/WCL/Eclipse CL)
また、当然ながらSymbolics等のLispマシンでは、実行可能ファイルのようなものはなく、相当するものとしては、コンパイル済みのアプリをロードする程度のことになります。Unixでいうとコンパイル可能なシェルスクリプトですべてが構成されているような感覚かと思いますが、やはり理想郷ですねえ。


HTML generated by 3bmd in LispWorks 8.0.0

俺Lisp拡張に俺RFIを出して俺実装するのも面白いのではないだろうか

Posted 2022-01-01 15:06:14 GMT

SchemeにはSRFI(Scheme Request for Implementation)、PythonにはPEPのようなものがありますが、俺Lisp拡張/ユーティリティのようなものに自分でRFIを書き自分で実装する、というもの面白いかなと思いつきました。
今年は、俺RFIを出して自分で実装してみたいと思います。

SRFIにテンプレートがあるので、これを下敷きにすると良さそう。


HTML generated by 3bmd in LispWorks 8.0.0

KMRCLを眺める(242) listener.lisp

Posted 2022-01-01 14:13:22 GMT

KMRCLを眺めるの242回目。今回は、listener.lispを眺めます。

listener.lisp を眺める

listener.lisp でいうlistenerはLisp処理系側でサーバを起動し、複数のコネクションを待ち受けるようなもののようです。
listenerクラスが複数のworkerクラスを保持するような構成になっています。

init/listener stop-all/listener

サーバの起動

(kl:init/listener
 (make-instance 'kl:listener
                :port 4006
                :function (lambda (io)
                            (write-line (read-line io nil) io)
                            (write-line "さようなら" io)
                            (force-output io)))
 :start)

外部から接続

% telnet localhost 4006
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
8888
8888
さようなら
Connection closed by foreign host.

サーバ終了

(kl:stop-all/listener)

なお、KMRCL内でのlistener.lispの応用としては、repl.lispがあります。


HTML generated by 3bmd in LispWorks 8.0.0

DG Common LispとDybvig先生

Posted 2021-12-31 21:03:39 GMT

DG Common Lispといえば、超マシンで名が知られているDGのMV/8000シリーズのMV/10000で稼動したCommon Lispですが、Kyoto Common Lispの最初のプラットフォームでもあります。

そんな、DG Common Lispのランタイムのコアな部分は、なんとChez Schemeや、Schemeの衛生マクロで有名な、Kent Dybvig先生が作っていたそうな。

Common Lispのλリストの煩雑さを反面教師に以後シンプルなデザインを心掛けるようになったとの由。


HTML generated by 3bmd in LispWorks 8.0.0

2021年振り返り

Posted 2021-12-31 14:02:21 GMT

恒例になっているので今年も振り返りのまとめを書きます。

Lisp的進捗

LispWorksでGUIアプリを作成して使うのが段々面白くなってきた一年でした。といっても大したものは作っていないのですが。

ブログ

今年書いた記事は71記事でした。 この数年、RSSとブログという文化自体が死滅しそうになっていて残念なのですが、2022年もブログは続けていきたいと思っています。
ブログと違ってSNSは発信が手軽というのはありますが、分散した情報をかき集めるのが一苦労なのです。情報の集約という点でブログ文化が好きだったのですが、多分ブログが盛り返すとこというもないでしょう。
SNSとブログでは、完全に棲み分けが進んだ感がありますが、昔は、本文が一行しかないようなブログ記事も普通にありましたし、2022年は一行二行でもブログに記事として投稿していこうかなと思います。

主に書き溜めたブログネタを成仏させる目的で開催したLisp一人 Advent Calendar 2021ですが、これを開催したお蔭で、どうでも良いことを書き散らかす、という感覚が戻ってきたように思います。 折角なので、この感じで書き散らかしていこうかなと思います。

LispWorks

LispWorks 8.0が登場しましたが、引き続きLispWorks生活は続けていこうと思います。 しかし、8.0でGTk版LispWorksの日本語入力に難が出たので、これだけが不安。

2022年の方向性

2022年は基本的に落穂拾い的にやっていこうかと考えていて、過去のブログ記事の保守や、WikipediaのLisp系記事の更新あたりを中心に活動してみたいと思っています。
また、処理系のマニュアルを隅から読んでいくようなのも好いかもしれません。
この数年<最強のIDE(開発フロントエンド)としてのCommon Lisp>というコンセプトで何か書いたり作ったりしたいと思っていたのですが、そうなるとOSの主要言語を学ぶ必要があります。Cが全然書けないので、Cの基礎を学んでCFFIでラッパーライブラリを沢山書けるようになりたいなと思ったりもしています。
また、Lispコミュニティについての考察みたいなものも大体まとまってきたので、そのうち書いたりしてみようかなと思ったりもしています。

過去のまとめ


HTML generated by 3bmd in LispWorks 8.0.0

Lisp₂とFUNCALL (2)

Posted 2021-12-30 21:24:08 GMT

Franz Lispの関数呼び出しの作法についてのツイートですが、今の感覚からすると確かに奇妙です。

bitの記事からの引用ですが、

Franz Lispのように、関数名のところが変数であれば、その変数の値を関数と思い、それがまた変数であれば今度はその変数の値を関数名だと思い、…といったことはしない

とあります。実はこれMACLISPと同じような挙動なのですが、昔にこのブログに記事を書いていたことを思い出したのでMACLISPと同じ挙動なのか確認してみました。

処理系は、simhのvax ultrix 4.0 上の franz lispです。

$ lisp
Franz Lisp, Opus 38.79

-> (setq x '(0 1 2 3)) (0 1 2 3)

-> (defun foo (x) x) foo

-> ((lambda (car) (car x)) 'foo) 0

carの大域関数定義が優先されるようです。

-> ((lambda (bar) (bar x)) 'foo)
(0 1 2 3)

しかし関数定義がなければ、変数の方を使います。

barの関数を定義すれば、そちらが優先されます。

-> (defun bar (x) (car x))
bar

-> ((lambda (bar) (bar x)) 'foo) 0

しかし、MACLISPと違って、car部に置くことができるのは、シンボルだけのようです。

-> ('car '(0 1 2))
Error: eval: Undefined function  'car

-> (#'car '(0 1 2 3)) Error: eval: Undefined function (function car)

ちなみに、MACLISPと同様にこの挙動はインタプリタだけで、ファイルをコンパイルした場合は、エラーになります。

;; foo.lisp
(defun foo (x)
  (let ((kar #'car))
    (kar x)))

$ liszt foo.lisp
Compilation begins with Liszt vax version 8.36
source: foo.lisp, result: foo.lisp.o
foo
%Note: foo.lisp: Compilation complete
%Note: foo.lisp:  Time: Real: 0:0, CPU: 0:0.00, GC: 0:0.00 for 0 gcs
%Note: foo.lisp: Assembly begins
%Note: foo.lisp: Assembly completed successfully

$ lisp Franz Lisp, Opus 38.79 -> (load "foo.lisp.o") [fasl foo.lisp.o] t -> (foo '(0 1 2 3 4)) Error: Undefined function called from compiled code kar

まとめ

ここまでインタプリタとコンパイラの挙動が違うと統一したくなる気持ちもわかります。

ちなみに、Lisp₁とLisp₂は名前空間の違いとして語られることが殆どですが、上記の実験からも分かるように、実は同じLisp₂でもフォームのcar部の評価方法も様々なものがあります(した)。
Lisp₁の

(car '(0 1 2 3))

をそのままLisp₂にうつすと

('car '(0 1 2 3))

となる筈です。
しかし、Common Lispではcar部は評価しないものとして定められているので、

(car '(0 1 2 3))

としか書くことができないこともあり、多分細かいことは色々スルーされているのでしょう。

MACLISPやFranz Lispのインタプリタではcar部も関数が出てくるまで評価する、ということなのですが、この辺りも私がCommon Lispの関数/マクロ定義は括弧を定義しているのに感覚として近いと考える所以です。

関連


HTML generated by 3bmd in LispWorks 8.0.0

KMRCLを眺める(241) byte-stream.lisp

Posted 2021-12-30 16:49:26 GMT

KMRCLを眺めるの241回目。今回は、byte-stream.lispを眺めます。

byte-stream.lisp を眺める

byte-stream.lispは(unsigned-byte 8)(uint8)な配列に対してのストリームインターフェイスを提供するライブラリです。
API(外部シンボル)は、

make-binary-array-output-streamget-output-stream-datadump-output-stream-datamake-byte-array-input-streamの4つですが、make-binary-array-output-streammake-byte-array-output-streamのタイポでしょう(もしくは修正で取り残されたか)

なお、対応している処理系はSBCL、CMLCL、Allegroだけのようです。

make-byte-array-output-stream

get-output-stream-data

dump-output-stream-data

Common Lisp標準のmake-string-output-streamget-output-stream-stringと同じような使い勝手です。
ただし、cl:get-output-stream-stringは、何度も実行可能ですが、kl:get-output-stream-dataの方はバッファをフラッシュしてしまうので、フラッシュしない場合は、dump-output-stream-dataを使うべし、ということみたいです。

(let ((out (kl::make-byte-array-output-stream)))
  (map nil
       (lambda (x) (write-byte x out))
       '(#xde #xad #xbe #xef))
  (list (kl:get-output-stream-data out)
        (kl:get-output-stream-data out)))(#(222 173 190 239) #())

(let ((out (kl::make-byte-array-output-stream))) (map nil (lambda (x) (write-byte x out)) '(#xde #xad #xbe #xef)) (list (kl:dump-output-stream-data out) (kl:dump-output-stream-data out)))(#(222 173 190 239) #(222 173 190 239))

make-byte-array-input-stream

(let ((in (kl::make-byte-array-input-stream (coerce #(222 173 190 239) '(array (unsigned-byte 8) (*))))))
  (loop :for x := (read-byte in nil in)
        :until (eq x in)
        :collect x))
→ (222 173 190 239)

実装について

SBCLとCMUCL版は結構内部関数を使っていますが、基本的にはバッファの構造体を定義して、ストリームはそのバッファ経由で読み書きする、というものです。
Allegro版はAllegroが提唱しているsimple-streamAPIで組んであります。


HTML generated by 3bmd in LispWorks 8.0.0

KMRCLを眺める(240) buff-input.lisp

Posted 2021-12-28 20:06:38 GMT

KMRCLを眺めるの240回目。今回は、color.lispを眺めます。

buff-input.lisp を眺める

read-buffered-fields, make-fields-buffer

(defun make-fields-buffer (&optional (max-fields +max-fields-per-line+)
                                   (max-field-len +max-field+))
  (let ((bufs (make-array max-fields :element-type 'vector :fill-pointer 0 :adjustable nil)))
    (dotimes (i +max-fields-per-line+)
      (setf (aref bufs i) (make-array max-field-len :element-type 'character :fill-pointer 0 :adjustable nil)))
    bufs))

(defun read-buffered-fields (fields strm &optional (field-delim +field-delim+) (eof 'eof)) "Read a line from a stream into a field buffers" (declare (type base-char field-delim) (type vector fields)) (setf (fill-pointer fields) 0) (do ((ifield 0 (1+ ifield)) (linedone nil) (is-eof nil)) (linedone (if is-eof eof fields)) (declare (type fixnum ifield) (type boolean linedone is-eof)) (let ((field (aref fields ifield))) (declare (type base-string field)) (do ((ipos 0) (fielddone nil) (rc (read-char strm nil +eof-char+) (read-char strm nil +eof-char+))) (fielddone (unread-char rc strm)) (declare (type fixnum ipos) (type base-char rc) (type boolean fielddone)) (cond ((char= rc field-delim) (setf (fill-pointer field) ipos) (setq fielddone t)) ((char= rc +newline+) (setf (fill-pointer field) ipos) (setf (fill-pointer fields) ifield) (setq fielddone t) (setq linedone t)) ((char= rc +eof-char+) (setf (fill-pointer field) ipos) (setf (fill-pointer fields) ifield) (setq fielddone t) (setq linedone t) (setq is-eof t)) (t (setf (char field ipos) rc) (incf ipos)))))))

make-fields-bufferは行単位のバッファを作成するユーティリティで、指定した数のフィールドを持ちます。デフォルトのデリミタは#\|ですが、csvやtsvのようにフィールドの間に置くのではなく、フィールドの後に置くタイプのようです。

read-buffered-fieldsは、ストリームから読んだ内容をバッファに保存します。

ちなみに、UTF-8の文字列を扱う場合は、(declare (type base-string field))では制限が強過ぎるのでstringあたりにする必要があります。
フィルポインタ付きの配列で何かバッファリングして読み込むようなコードの例としては、一番シンプルで参考になるかなと思いました。

(with-input-from-string (in "*print-miser-width*    0   
*print-pprint-dispatch* 0   
*print-readably*    0   
*print-right-margin*    0   
*read-eval* 0   
abort   0   
add-method  0   
allocate-instance   0   
arithmetic-error    0   
arithmetic-error-operands   0   
arithmetic-error-operation  0   
array   1   
array-displacement  0   
base-char   0   
base-string 0   
bignum  1   
bit-vector  1   
boolean 0   ")
  (loop :repeat 10 :collect (kl:read-buffered-fields (kl:make-fields-buffer) in #\Tab)))(#("*print-miser-width*" "0")
   #("*print-pprint-dispatch*" "0")
   #("*print-readably*" "0")
   #("*print-right-margin*" "0")
   #("*read-eval*" "0")
   #("abort" "0")
   #("add-method" "0")
   #("allocate-instance" "0")
   #("arithmetic-error" "0")
   #("arithmetic-error-operands" "0"))

なお、buff-input.lispにはこれらの亜種のような定義が数点ありますが、どうもつくりかけっぽくエクスポートもされていません。


HTML generated by 3bmd in LispWorks 8.0.0

KMRCLを眺める(239) color.lisp

Posted 2021-12-26 17:50:14 GMT

KMRCLを眺めるの239回目。今回は、color.lispを眺めます。

color.lisp を眺める

どんなユーティリティかと思って中身を覗いてみましたが、Common Lispにはあまり関係なくCGにおける色操作関係のユーティリティのようです。

お馴染のRGBと、グラフィックスアプリでよくみかける色相環と△のHSVの変換ユーティリティが主です。

rgb→hsv

(defun rgb->hsv (r g b)
  (declare (optimize (speed 3) (safety 0)))

(let* ((min (min r g b)) (max (max r g b)) (delta (- max min)) (v max) (s 0) (h nil))

(when (plusp max) (setq s (/ delta max)))

(when (plusp delta) (setq h (* 60 (cond ((= max r) (/ (- g b) delta)) ((= max g) (+ 2 (/ (- b r) delta))) (t (+ 4 (/ (- r g) delta)))))) (when (minusp h) (incf h 360)))

(values h s v)))

rgbをhsvに変換します。rgbの最大値を基準とした割合で計算する様子

(rgb->hsv 1 0 0)
→ 0
  1
  255

rgb255→hsv255

(defun rgb255->hsv255 (r g b)
  "Integer convert from rgb from 0-255 -> h from 0-360 and sv from 0-255"
  (declare (fixnum r g b)
           (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0)))

(let* ((min (min r g b)) (max (max r g b)) (delta (- max min)) (v max) (s 0) (h nil)) (declare (fixnum min max delta v s) (type (or null fixnum) h))

(when (plusp max) (setq s (round (the fixnum (* 255 delta)) max)))

(when (plusp delta) (setq h (cond ((= max r) (round (the fixnum (* 60 (the fixnum (- g b)))) delta)) ((= max g) (the fixnum (+ 120 (round (the fixnum (* 60 (the fixnum (- b r)))) delta)))) (t (the fixnum (+ 240 (round (the fixnum (* 60 (the fixnum (- r g)))) delta)))))) (when (minusp h) (incf h 360)))

(values h s v)))

rgbをhsvに変換します。こちらは、256階調で値を返します。

(rgb255->hsv255 #xff #x00 #x00)
→ 0 
  255 
  255 

hsv→rgb

(defun hsv->rgb (h s v)
  (declare (optimize (speed 3) (safety 0)))
  (when (zerop s)
    (return-from hsv->rgb (values v v v)))

(while (minusp h) (incf h 360)) (while (>= h 360) (decf h 360))

(let ((h-pos (/ h 60))) (multiple-value-bind (h-int h-frac) (truncate h-pos) (declare (fixnum h-int)) (let ((p (* v (- 1 s))) (q (* v (- 1 (* s h-frac)))) (t_ (* v (- 1 (* s (- 1 h-frac))))) r g b)

(cond ((zerop h-int) (setf r v g t_ b p)) ((= 1 h-int) (setf r q g v b p)) ((= 2 h-int) (setf r p g v b t_)) ((= 3 h-int) (setf r p g q b v)) ((= 4 h-int) (setf r t_ g p b v)) ((= 5 h-int) (setf r v g p b q))) (values r g b)))))

hsv→rgbの逆

hsv255→rgb255

(defun hsv255->rgb255 (h s v)
  (declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0)))

(when (zerop s) (return-from hsv255->rgb255 (values v v v)))

(locally (declare (type fixnum h s v)) (while (minusp h) (incf h 360)) (while (>= h 360) (decf h 360))

(let ((h-pos (/ h 60))) (multiple-value-bind (h-int h-frac) (truncate h-pos) (declare (fixnum h-int)) (let* ((fs (/ s 255)) (fv (/ v 255)) (p (round (* 255 fv (- 1 fs)))) (q (round (* 255 fv (- 1 (* fs h-frac))))) (t_ (round (* 255 fv (- 1 (* fs (- 1 h-frac)))))) r g b)

(cond ((zerop h-int) (setf r v g t_ b p)) ((= 1 h-int) (setf r q g v b p)) ((= 2 h-int) (setf r p g v b t_)) ((= 3 h-int) (setf r p g q b v)) ((= 4 h-int) (setf r t_ g p b v)) ((= 5 h-int) (setf r v g p b q))) (values r g b))))))

hsv255→rgb255の逆

hsv-equal

(defun hsv-equal (h1 s1 v1 h2 s2 v2 &key (limit .001))
  (declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0)))
  (flet ((~= (a b)
           (cond
            ((and (null a) (null b))
             t)
            ((or (null a) (null b))
             nil)
            (t
             (< (abs (- a b)) limit)))))
    (cond
     ((and (~= 0 v1) (~= 0 v2))
      t)
     ((or (null h1) (null h2))
      (when (and (~= 0 s1) (~= 0 s2) (~= v1 v2))
        t))
     (t
      (when (~= h1 h2) (~= s1 s2) (~= v1 v2)
        t)))))

hsvの等価判定。whenの返り値を使うのが気持ち悪いという人もいるかもしれません。
(~= h1 h2) (~= s1 s2) (~= v1 v2)は、(and (~= h1 h2) (~= s1 s2) (~= v1 v2))の間違いでしょうか。

(hsv-equal 255 0 0
           255 0 0)

→ T

hsv255-equal

(defun hsv255-equal (h1 s1 v1 h2 s2 v2 &key (limit 1))
  (declare (type fixnum s1 v1 s2 v2 limit)
           (type (or null fixnum) h1 h2)
           (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0)))
  (flet ((~= (a b)
           (declare (type (or null fixnum) a b))
           (cond
            ((and (null a) (null b))
             t)
            ((or (null a) (null b))
             nil)
            (t
             (<= (abs (the fixnum (- a b))) limit)))))
    (cond
     ((and (~= 0 v1) (~= 0 v2))
      t)
     ((or (null h1) (null h2))
      (when (and (~= 0 s1) (~= 0 s2) (~= v1 v2))
        t))
     (t
      (when (~= h1 h2) (~= s1 s2) (~= v1 v2)
        t)))))

hsv-equalにほぼおなじ。ユースケース的に分かり易くしたものでしょう。

hsv-similar

(defun hsv-similar (h1 s1 v1 h2 s2 v2 &key
                       (hue-range 15) (value-range .2) (saturation-range 0.2)
                       (gray-limit 0.3) (black-limit 0.3))
  "Returns T if two HSV values are similar."
  (cond
   ;; all black colors are similar
   ((and (<= v1 black-limit) (<= v2 black-limit))
    t)
   ;; all desaturated (gray) colors are similar for a value, despite hue
   ((and (<= s1 gray-limit) (<= s2 gray-limit))
    (when (<= (abs (- v1 v2)) value-range)
      t))
   (t
    (when (and (<= (abs (hue-difference h1 h2)) hue-range)
               (<= (abs (- v1 v2)) value-range)
               (<= (abs (- s1 s2)) saturation-range))
      t))))

hsvの類似度判定

(hsv-similar 255 0 0
             255 0 1
             :hue-range 15)

→ nil

hsv255-similar

(defun hsv255-similar (h1 s1 v1 h2 s2 v2
                          &key (hue-range 15) (value-range 50) (saturation-range 50)
                          (gray-limit 75) (black-limit 75))
  "Returns T if two HSV values are similar."
  (declare (fixnum s1 v1 s2 v2 hue-range value-range saturation-range
                   gray-limit black-limit)
           (type (or null fixnum) h1 h2)
           (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0)))
  (cond
   ;; all black colors are similar
   ((and (<= v1 black-limit) (<= v2 black-limit))
    t)
   ;; all desaturated (gray) colors are similar for a value, despite hue
   ((and (<= s1 gray-limit) (<= s2 gray-limit))
    (when (<= (abs (- v1 v2)) value-range)
      t))
   (t
    (when (and (<= (abs (hue-difference-fixnum h1 h2)) hue-range)
               (<= (abs (- v1 v2)) value-range)
               (<= (abs (- s1 s2)) saturation-range))
      t))))

hsv-similarの亜種。

hue-difference

(defun hue-difference (h1 h2)
  "Return difference between two hues around 360 degree circle"
  (cond
   ((and (null h1) (null h2))
    t)
   ((or (null h1) (null h2))
    360)
   (t
    (let ((diff (- h2 h1)))
      (cond
       ((< diff -180)
        (+ 360 diff)
        )
       ((> diff 180)
        (- (- 360 diff)))
       (t
        diff))))))

hueの引き算。360度での計算になります。

(hue-difference-fixnum -361 -1)
→ 0 

hue-difference-fixnum

(defun hue-difference-fixnum (h1 h2)
  "Return difference between two hues around 360 degree circle"
  (cond
   ((and (null h1) (null h2))
    t)
   ((or (null h1) (null h2))
    360)
   (t
    (locally (declare (type fixnum h1 h2))
      (let ((diff (- h2 h1)))
        (cond
         ((< diff -180)
          (+ 360 diff)
          )
         ((> diff 180)
          (- (- 360 diff)))
         (t
          diff)))))))

hue-differenceの亜種。

このコードの中身とは関係ないところですが、 type declarations can be free declarations or bound declarations.

なので、

    (locally (declare (type fixnum h1 h2))
      (let ((diff (- h2 h1)))
        (cond
         ((< diff -180)
          (+ 360 diff)
          )
         ((> diff 180)
          (- (- 360 diff)))
         (t
          diff))))

は、

    (let ((diff (- h2 h1)))
      (declare (type fixnum h1 h2))
        (cond
         ((< diff -180)
          (+ 360 diff)
          )
         ((> diff 180)
          (- (- 360 diff)))
         (t
          diff)))

と書けます。まあ気持ち悪い人には気持ち悪いかもしれません。


HTML generated by 3bmd in LispWorks 8.0.0

KMRCLを眺める(238) hash.lisp

Posted 2021-12-25 19:18:12 GMT

先日久々にKMRCLを眺めましたが、確認してみるとあと8ファイル眺めればKMRCLは読破できるようなので読み進めてみることにします。

hash.lisp を眺める

print-hash

hash.lispの中身はprint-hashのみです。

(defun print-hash (h &key (stream *standard-output*)
                   key-transform-fn value-transform-fn
                   (prefix "") (divider " -> ") (terminator "~%"))
  (maphash #'(lambda (k v)
               (format stream "~A~S~A~S"
                       prefix
                       (if key-transform-fn
                           (funcall key-transform-fn k)
                           k)
                       divider
                       (if value-transform-fn
                           (funcall value-transform-fn v)
                           v))
               (when terminator (format stream terminator)))
           h)
  h)

名前のとおりhash-tableの中身を印字するものです。
SBCL等は、describeで鍵/値の確認はできませんが、LispWorks等では中身を表示してくれるので、そういう処理系では不要かもしれません。

;;; SBCL
* (describe (alexandria:plist-hash-table '(a 0 b 1 c 2)))
#<HASH-TABLE :TEST EQL :COUNT 3 {1003D22A03}>
  [hash-table]

Occupancy: 0.4 Rehash-threshold: 1.0 Rehash-size: 1.5 Size: 7 Synchronized: no

;;; LispWorks
(describe (alexandria:plist-hash-table '(a 0 b 1 c 2)))

#<eql Hash Table{3} 40111C0803> is a hash-table b 1 c 2 a 0

LispWorksの場合は、lw:*inspect-through-gui*Tに設定してのinspectの使い勝手が良いのでそちらでも良いでしょう。


HTML generated by 3bmd in LispWorks 8.0.0

&list-of

Posted 2021-12-24 19:14:45 GMT

Lisp一人 Advent Calendar 2021 25日目の記事です。

本アドベントカレンダー最終日ですが、特にどうということもなくLispネタを書いてゆきます。
開始前は、溜っていたネタを書いていくだけ、と考えていましたが、良く考えてみれば、記事にできないから溜ってしまったネタが多く、思いの外記事を作成するのに苦労してしまいました。
これだったらマイナーなテーマのアドベントカレンダーの方が楽だったかもしれません。

さて、今回は、λリストの&list-ofを紹介します。
&list-ofは、Common Lispには取り入れられなかったλリストなのですが、defmacroletのような束縛構文を作成する際に頻出するパタンである、変数および値一覧の取得に便利に使えるものです。

(destructuring-bind (&rest &list-of (vars vals))
                    '((a 0)
                      (b 1)
                      (c 2))
  (list vars vals))((a b c) (0 1 2)) 

試してみたい方はいないと思いますが、昔に何故かxyzzy用に移植したものがCommon Lispでそのまま動くので一応Gistのリンクを貼っておきます。

これでdefmacroを作成するとこんな風になります

(defpackage "25d76a1c-7e26-5d83-8b7f-2afe5af560c1" 
  (:use cl destructuring)
  (:shadowing-import-from destructuring destructuring-bind &list-of)
  (:shadow defmacro))

(in-package "25d76a1c-7e26-5d83-8b7f-2afe5af560c1")

(cl:defmacro defmacro (name (&rest args) &body body) (let ((op (gensym "op")) (form (gensym "form")) (env (gensym "env"))) `(eval-when (:compile-toplevel :load-toplevel :execute) (setf (macro-function ',name) (lambda (,form ,env) (destructuring-bind (,op ,@args) ,form (locally (declare (ignore ,op ,env)) ,@body)))))))

これで、let的な構文を作成するのに&list-ofを使うと、このようにシンプルに書けます。

(defmacro mylet (&list-of (vars vals) &body body)
  `(multiple-value-bind (,@vars) (values ,@vals)
     ,@body))

(mylet ((a 0)
        (b 1)
        (c 2))
       (list a b c))
===>
(multiple-value-bind (a b c)
                     (values 0 1 2) 
  (list a b c))(0 1 2)

まとめ

今回は&list-ofについての誰得情報を書いてみました。
古えに使われていたλリストについては、Lispマシンマニュアルに詳しい解説があるので、興味のある方は眺めてみてはいかがでしょうか。


HTML generated by 3bmd in LispWorks 8.0.0

超螺旋なMOP

Posted 2021-12-23 19:39:29 GMT

Lisp一人 Advent Calendar 2021 24日目の記事です。

MOPについて面白そうな文献がないかウェブを漁っていたら、面白そうな論文を見付けました。

Meta-Helixというのは、クラス⇔インスタンスの関係に加えて、implemented-ofというインスタンス⇔実装の中身、という関係を入れたことで関係が螺旋状になっているのに由来するようですが、一応論文の流れを解説すると、CLOS MOPとTiny CLOS MOPを検討し、これらが持つ問題をMeta-Helical MOPで解決しようというところです。
AvoidingConfusion in Metacircularityというタイトルですが、CLOS MOPの方ではslot-valueslot-value-using-classの定義を無限ループさせてしまうことはたまにあるので、確かにそうかなという気はします。
ただし、この論文ではCLOS MOPのそういう超循環的な構成はプログラムとしては理解しやすいという長所はあり、Tiny CLOSのように、スロットと実装のフィールドを分けるのは複雑さを増している、としています。

さて、では超螺旋なMOPだとどういった構成になるのかというと、上述のようにシンプルにオブジェクトにimplemented-ofという関係を付け加えただけです。

昨年、このブログでallocate-instance アドベントカレンダーというのを開催してみましたが、バッキングストレージを別のオブジェクトにするというのは何パタンか試していて、オブジェクトの一連のスロットが別のオブジェクトというパタンかと思います。

なお、Meta-Helixは、コンパイル時/実行時の両方での実現を視野に入れたMOPですが、この論文では説明の都合上実行時のMeta-Helical MOPについての解説が主です。

……ということで実行時超螺旋MOPを実現するメタクラスを下記のように書いてみました。
なお、コードを単純にするため、オブジェクトのスロットをいじるのに自作のライブラリを使っています。

;; https://github.com/g000001/slotted-objects
(ql:quickload '(closer-mop slotted-objects))

(defpackage "ee552d98-e6ee-53f5-98a6-09edb2b2b5ea" (:use c2cl slotted-objects))

(in-package "ee552d98-e6ee-53f5-98a6-09edb2b2b5ea")

(defclass meta-helix-class (slotted-class) ((implemented-by :initform (find-class 'standard-class) :accessor class-implemented-by :initarg :implemented-by)))

(defmethod validate-superclass ((c meta-helix-class) (s standard-class)) T)

(defclass meta-helix-object (slotted-object) () (:metaclass meta-helix-class))

(defgeneric implemented-by (object))

(defmethod implemented-by ((object meta-helix-object)) (instance-slots object))

(defmethod allocate-instance ((class meta-helix-class) &rest initargs) (allocate-slotted-instance (class-wrapper class) (make-instance (class-implemented-by class))))

(defmethod slot-value-using-class ((class meta-helix-class) instance (slotd slot-definition)) (slot-value-using-class (class-implemented-by class) (implemented-by instance) slotd))

(defmethod (setf slot-value-using-class) (value (class meta-helix-class) instance (slotd slot-definition)) (setf (slot-value-using-class (class-implemented-by class) (implemented-by instance) slotd) value))

#+lispworks (defmethod clos:process-a-class-option ((class meta-helix-class) (name (eql :implemented-by)) value) (unless (and value (null (cdr value))) (error "meta-helix-class :implemented-by must have a single value.")) `(,name ',(car value)))

#-lispworks (defmethod ensure-class-using-class :around ((class meta-helix-class) name &rest initargs &key (implemented-by nil implemented-by-p)) (if (and implemented-by-p (consp implemented-by)) (apply #'call-next-method class name :implemented-by (car implemented-by) initargs) (call-next-method)))

論文の例を試してみる

まず、xyのスロットを有するpointオブジェクトを考えます。

(defclass point ()
  (x y))

このオブジェクトにスロットアクセスの履歴を付けたい、という場合、履歴スロット含んだpoint*pointの実装オブジェクトとして定義します。
このオブジェクトは何等メタな細工はされていないstandard-objectのサブクラスオブジェクトです。

(defclass point* ()
  ((history :initform '())
   (x :initform 0)
   (y :initform 0)))

このpoint*を利用するようにpoint側を定義します。

(defclass history-class (meta-helix-class)
  ())

(defclass history-object () () (:metaclass history-class))

(defclass point (meta-helix-object) (x y) (:metaclass history-class) (:implemented-by point*))

論文のコード例に似せて、history-class/history-objectを定義しましたが、関係が捻れているので逆にわかり辛いかもしれません。
論文には:implemented-byの関係を記述する方法が記載されていないようですが、クラスのオプションで適当に指定することにしました。

そしてスロットのアクセス時にhistoryスロットに履歴を記録するようにします。

(defmethod slot-value-using-class ((class history-class) object (slotd slot-definition))
  (let* ((implemented-by (implemented-by object))
         (slot-name (slot-definition-name slotd)))
    (push `(slot-value ,slot-name)
          (slot-value implemented-by 'history))
    (slot-value implemented-by slot-name)))

(defmethod (setf slot-value-using-class) (value (class history-class) object (slotd slot-definition)) (let* ((implemented-by (implemented-by object)) (slot-name (slot-definition-name slotd))) (push `((setf slot-value) ,slot-name) (slot-value implemented-by 'history)) (setf (slot-value implemented-by slot-name) value)))

一見して判るようにimplemented-byでリダイレクトしているだけです。

これでこのように使えます。

(let ((point (make-instance 'point)))
  (setf (slot-value point 'x) 42)
  (slot-value point 'y)
  (slot-value point 'x)
  (slot-value (implemented-by point) 'history))((slot-value x) (slot-value y) ((setf slot-value) x)) 

コンパイル時超螺旋MOP

コンパイル時MOPというのは、基本的にコンパイル時にのみ存在するメタオブジェクトを操作してあれこれするものですが、implemented-byの関係は、Common Lispであれば、マクロやコンパイラマクロ等で、コンパイル時に展開してしまえそうです。
例えば、上記の例は、

(let ((point (make-instance 'point*)))
  (progn
    (push `((setf slot-value) x)
          (slot-value point 'history))
    (setf (slot-value point 'x) 42))
  (progn
    (push `(slot-value y)
          (slot-value point 'history))
    (slot-value point 'y))
  (progn
    (push `(slot-value x)
          (slot-value point 'history))
    (slot-value point 'x))
  (slot-value point 'history))((slot-value x) (slot-value y) ((setf slot-value) x)) 

という風に展開すれば良いことになります。

まとめ

Meta-Helixという名称は特に広まっていないようですが、実行時MOPとコンパイル時MOPを繋ぐような概念かなと思いました。
これまでこのブログでも<MOP vs マクロ>のようなことを書いてきましたが、implemented-ofの関係で整理できないか試してみたいところです。

関連


HTML generated by 3bmd in LispWorks 8.0.0

コンパイラマクロ内でも型宣言情報くらいは扱えるのでは?

Posted 2021-12-23 14:35:02 GMT

Lisp一人 Advent Calendar 2021 23日目の記事です。

SBCLではコンパイラマクロの発展形のようなdeftransformでコンパイル時の型情報を扱って式の展開を制御できたりします。
下記は、x+yという2引数の関数の型情報をみてコンパイル時に式を展開する例です。

#+sbcl
(sb-c:defknown x+y (t t) t () :overwrite-fndb-silently t)

(sb-c:deftransform x+y ((x y) (cl:number cl:number)) '(cl:+ x y))

(sb-c:deftransform x+y ((x y) (cl:list cl:list)) '(cl:append x y))

(sb-c:deftransform x+y ((x y) (cl:string cl:string)) '(cl:concatenate 'cl:string x y))

SBCLでしか使えないのが残念ですが、しかし、良く考えてみると、型の情報は取得できなくても、変数の型宣言の情報は、variable-informationで取得できるので、コンパイル時にコンパイラマクロで展開を制御できるのではないかと思ったので、試しに書いてみます。

(import #+sbcl 'sb-cltl2:variable-information
        #+lispworks 'hcl:variable-information
        #+allegro 'sys:variable-information)

;;; デフォルトの挙動 (defun foo (x) (list :default x))

(foo 42)(:default 42)

;;; コンパイル時に展開を制御するユーティリティ (defmacro variable-information-typecase (var env &body clauses) `(case (cdr (assoc 'type (nth-value 2 (variable-information ,var ,env)))) ,@clauses))

;;; foo にコンパイラマクロを設定 (define-compiler-macro foo (&whole w x &environment env) (variable-information-typecase x env (fixnum `(list 'fixnum ,x)) (string `(list 'string ,x)) (symbol `(list 'symbol ,x)) (T w)))

コンパイラマクロを設定したので、コンパイルして確認してみます。

(defun fixnum-bar (x)
  (declare (type fixnum x))
  (foo x))

(defun string-bar (x) (declare (type string x)) (foo x))

(defun symbol-bar (x) (declare (type symbol x)) (foo x))

(fixnum-bar 42)(fixnum 42)

(string-bar "foo")(string "foo")

(symbol-bar 'foo)(symbol foo)

できました!

型宣言がないと分岐できないものの、宣言を活用すれば、コンパイル時に展開を分岐することは可能みたいです。
ちなみに、Allegroは型の名前がちょっと違うので、上の定義では上手く行きません。
variable-information 自体がCLtL2の拡張なので可搬的ではありませんが、サポートしている処理系はそこそこ多いので活用できるのではないでしょうか。


HTML generated by 3bmd in LispWorks 8.0.0

(帰ってきた)KMRCLを眺める(237) math.lisp

Posted 2021-12-21 21:00:32 GMT

Lisp一人 Advent Calendar 2021 22日目の記事です。

記事にまとめられるネタが切れてしまったので、十年ぶりにKMRCLを眺めてみたいと思います。

いまから十年程前には、KMRCLを眺める、というお題で毎日のようにKMRCLのコード片を眺めてブログ記事にしていましたが、実に236回もやっていたようです。
しかし、その割には未だに完読していません。

math.lisp を眺める

どこまで読み進めたかのメモを残していた筈なのですが、みつからないため、本ブログを検索して該当なしなので、未だ眺めていないと思われるmath.lispを眺めます。

deriv sin^

(in-package #:kmrcl)

(defun deriv (f dx) #'(lambda (x) (/ (- (funcall f (+ x dx)) (funcall f x)) dx)))

(defun sin^ (x) (funcall (deriv #'sin 1d-8) x))

よくある微分ユーティリティです。

(funcall (deriv (lambda (x) (expt x 2)) 1d-8) 8)
→ 15.999998481674993D0

(sin^ pi) → -0.999999993922529D0

ensure-integer

(defmacro ensure-integer (obj)
  "Ensure object is an integer. If it is a string, then parse it"
  `(if (stringp ,obj)
      (parse-integer ,obj)
     ,obj))

parse-integerを若干安全にした感じでしょうか。nilでのエラーを回避するため?

(ensure-integer "42")
→ 42
  2

histogram

(defun histogram (v n-bins &key min max)
  (declare (fixnum n-bins))
  (when (listp v)
    (setq v (coerce v 'vector)))
  (when (zerop (length v))
    (return-from histogram (values nil nil nil)) )
  (let ((n (length v))
        (bins (make-array n-bins :element-type 'integer :initial-element 0))
        found-min found-max)
    (declare (fixnum n))
    (unless (and min max)
      (setq found-min (aref v 0)
            found-max (aref v 0))
      (loop for i fixnum from 1 to (1- n)
          do
            (let ((x (aref v i)))
              (cond
               ((> x found-max)
                (setq found-max x))
               ((< x found-min)
                (setq found-min x)))))
      (unless min
        (setq min found-min))
      (unless max
        (setq max found-max)))
    (let ((width (/ (- max min) n-bins)))
      (setq width (+ width (* double-float-epsilon width)))
      (dotimes (i n)
        (let ((bin (nth-value 0 (truncate (- (aref v i) min) width))))
          (declare (fixnum bin))
          (when (and (not (minusp bin))
                     (< bin n-bins))
            (incf (aref bins bin))))))
    (values bins min max)))

Wikipediaのヒストグラムの例を計算してみるとこんな感じです。

(histogram '(78 126 156 231 215 304 484 544 566 545 478 258 225 373 620 
             625 606 483 377 370 587 667 643 756 505 436 399 611 679 575 565)
           8
           :min 0
           :max 799)
→ #(1 2 4 5 4 7 7 1)
  0
  799

wp-histogram

fixnum-width

(defun fixnum-width ()
  (nth-value 0 (truncate (+ (/ (log (1+ most-positive-fixnum)) (log 2)) .5))))

(integer-length most-positive-fixnum) → 60

と同じ気がするんですが、何か違ってくるのかもしれない。

(fixnum-width)
→ 60

scaled-epsilon

(defun scaled-epsilon (float &optional (operation '+))
  "Return the smallest number that would return a value different from
  FLOAT if OPERATION were applied to FLOAT and this number.  OPERATION
  should be either + or -, and defauls to +."
  (multiple-value-bind (significand exponent)
      (decode-float float)
    (multiple-value-bind (1.0-significand 1.0-exponent)
        (decode-float (float 1.0 float))
      (if (and (eq operation '-)
               (= significand 1.0-significand))
          (scale-float (typecase float
                         (short-float short-float-negative-epsilon)
                         (single-float single-float-negative-epsilon)
                         (double-float double-float-negative-epsilon)
                         (long-float long-float-negative-epsilon))
                       (- exponent 1.0-exponent))
        (scale-float (typecase float
                       (short-float short-float-epsilon)
                       (single-float single-float-epsilon)
                       (double-float double-float-epsilon)
                       (long-float long-float-epsilon))
                     (- exponent 1.0-exponent))))))

このユーティリティの使い方が良く分からないのですが誤差を確認するためのものでしょうか。

sinc

(defun sinc (x)
  (if (zerop x)
      1d0
    (let ((x (coerce x 'double-float)))
      (/ (sin x) x))))

double-floatを返す非正規化sinc関数です。

numbers-within-percentage

(defun numbers-within-percentage (a b percent)
  "Determines if two numbers are equal within a percentage difference."
  (let ((abs-diff (* 0.01 percent 0.5 (+ (abs a) (abs b)))))
    (< (abs (- a b)) abs-diff)))

或る二つの数が指定されたパーセントの誤差範囲に収まっているかを確認するものです。

(numbers-within-percentage 100 96 5)
→ t

(numbers-within-percentage 100 94 5) → nil

まとめ

実に十年ぶりにKMRCLを眺めましたが、237回も記事にしているなら流石に完読を目指したいところです。


HTML generated by 3bmd in LispWorks 8.0.0

RISC-IVとLisp

Posted 2021-12-20 19:12:17 GMT

Lisp一人 Advent Calendar 2021 21日目の記事です。

RISC-Vが盛り上がっている昨今ですが、RISC-IVはLisp向けアーキテクチャだったことはご存知でしょうか。
などと、はじめましたが、RISC-VとRISC-IV間でアーキテクチャ的な継承をしていたりはないようです。残念。
そもそも、RISC-IVは、1988年あたりのプロジェクトで、RISC-Vは2010年あたりに開始だそうなので、年月的にも大分隔があります。

RISC-IV(SPUR)プロセッサとは

RISC-IVは、SPURと呼ばれていましたが、Symbolic Processing Using RISCsの略だそうで、そのまま解釈すると並列記号処理向けRISCというところです。
プロジェクトも実際にSMP構成のプロセッサを複数台接続し、分散OSで並列処理のLispを動かす試みというところだったようです。
Lispは、CMUCLやSBCLの先祖であるSpice Lispを並列処理拡張したもので、SPUR Lispという名前でした。

1988年当時は、並列Lispが結構熱い時代でしたが、Connection Machine Lispのような超並列マシンでデータ並列ではなく、それらからすると比較的少数のSMP構成のプロセッサを繋ぐものだったようです。
Common Lisp規格には並列/並行の規定がないため、SPUR Lispでは、メールボックスを基礎とし、その上にfutureやdelayを構成するような拡張をしていたとのことですが、近年のネイティブスレッド対応のCommon Lisp処理系は大体似たような拡張をしているかなと思います(futureやdelayの活用はあまり見掛けない気はしますが)し、SPURマシンの標準的プロセッサ数は多くても12台程度だったようなので最近のPCのコア数と大差ない感じです。

一応、SPURプロセッサのLisp向け機能としては、タグアーキテクチャ、世代別GCのハードウェア支援、関数呼び出しの高速化(レジスタウィンドウ)があるようです。

EECS at UC BerkeleyでSPURで検索すると文献が結構ありますので興味のある方は眺めてみてはいかがでしょうか。

参照


HTML generated by 3bmd in LispWorks 8.0.0

世の中の人のLispの括弧が駄目というのは、コードがデータに見えてしまって駄目ということなのではないか説

Posted 2021-12-19 18:13:07 GMT

Lisp一人 Advent Calendar 2021 20日目の記事です。

世の中の人のLispの括弧が駄目というのは、コードがデータに見えてしまって駄目ということなのではないか説

表題のとおりなのですが、このブログの読者はS式で記述されたコードに順応し過ぎている方が殆どだと思いますので、Lisperにも直感的に伝わるように表現するならば、どうにもS式が駄目だ、という人は、こういうコードが、

;;; S式
(defun fib (n)
   (if (< n 2)
       n
       (+ (fib (1- n))
          (fib (- n 2)))))

こう見えている可能性があるんじゃないでしょうか

;;; リスト
#.(list 'defun
        'fib
        (list 'n)
        (list 'if
              (list '< 'n '2)
              'n
              (list '+ 
                    (list 'fib (list '1- 'n))
                    (list 'fib (list '- 'n 2)))))

これなら流石のLisperでも、コードというよりデータに見えるでしょう。

以前、色々な言語でS式を書いてみるというのを試してみましたが、データの表記は大抵、括弧で括られています。

人よっては括弧で括られたものは、何をどうしてもデータに見えてしまうのではないでしょうか。
Lisperには嫌われるぶら下り括弧もコードがデータに見えないようにする為の抵抗に思えたりもしなくもありません(まあ括弧の対応のためというのもありますが)

ちなみに、S式も、カンマ区切りにすると、コードよりはデータに見えてきます。

;;; S式
(defun, fib, (n),
   (if, (<, n, 2),
       n,
       (+, (fib, (1-, n)),
           (fib, (-, n, 2)))))

S式はこのコードとデータの表記の間の絶妙なバランスで成立している気がしてきました。

鶏と卵の問題ですが、コードとデータを行き来するような言語が流行れば、必然的にS式のような表記体系に落ち着くのではないでしょうか。


HTML generated by 3bmd in LispWorks 8.0.0

not-implementedを充実させる

Posted 2021-12-18 23:08:38 GMT

Lisp一人 Advent Calendar 2021 19日目の記事です。

ブログ記事で未実装の関数定義のHaskellでの取扱い方法を読み、Common Lispでも実現できそうだと思いメモしていましたが、いつの間にか九年程経過していました。
元ブログも消滅してしまったようです……。

さて、not-implementedのようなプレイスホルダー自体はCommon Lispでも良く見掛ける手法で、中身はerrorをあげるものになっていることが殆どかと思います。
今回は、コンパイル時には警告、実行時にはエラー、というマクロを定義してみたいと思います。
おまけでコンパイル時に警告を出すtodofixmeも作成してみます。

(define-condition not-implemented-error (simple-error)
  ())

(define-condition not-implemented-warning (simple-warning) ())

(define-condition todo (simple-warning) ())

(define-condition fixme (simple-warning) ())

(defun get-block-name (env) #+sbcl (caar (sb-c::lexenv-blocks env)) #+lispworks (caar (compiler::compiler-environment-benv env)))

(defmacro not-implemented (&environment env) (let ((fmtargs (list :format-control "~S : not implemented for ~A ~A" :format-arguments (list (get-block-name env) (lisp-implementation-type) (lisp-implementation-version))))) (apply #'warn 'not-implemented-warning fmtargs) `(error 'not-implemented-error ,@(mapcar (lambda (a) `',a) fmtargs))))

(defmacro todo (msg &environment env) (warn 'todo :format-control "~S : TODO : ~A" :format-arguments (list (get-block-name env) msg)) nil)

(defmacro fixme (msg &body body &environment env) (warn 'fixme :format-control "~S : FIXME : ~A" :format-arguments (list (get-block-name env) msg)) `(progn ,@body))

使ってみる

(defun foo (x)
  (not-implemented)
  (todo "ご飯食べてから実装する")
  (fixme "治して……"
    (* 42 x)))

3 compiler notes:

g001992.lisp:109:3: warning: foo : not implemented for SBCL 1.4.12

g001992.lisp:110:3: warning: foo : TODO : ご飯食べてから実装する

g001992.lisp:111:3: warning: foo : FIXME : 治して……

Compilation failed.

(foo 8)
!>> foo : not implemented for LispWorks 8.0.0

まとめ

ブロック名を取得するのにANSI CL規格外機能を利用していますが、その他はマクロ展開時にwarnを出しているだけです。
処理系によってはwarnにブロック名をつけるので不要だったりはするのですが。


HTML generated by 3bmd in LispWorks 8.0.0

読取時とマクロ展開時を横断したマクロ

Posted 2021-12-18 13:32:34 GMT

Lisp一人 Advent Calendar 2021 19日目の記事です。

Common Lispでは処理系依存の処理を記述するのに#-/#+を使いますが、込み入った条件の場合は結構面倒で、それに伴なったデフォルトケースの記述も面倒です。
既に色々解決方法は考えられていると思いますが、自分もちょっと考えてみました。

(defmacro feature-case (&body clauses)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     (macrolet ((run ()
                  (read-from-string 
                   ,(with-output-to-string (out)
                      (format out "~&(cond ~%")
                      (dolist (c clauses)
                        (typecase (cadr c)
                          (STRING 
                           (format out
                                   "~&#+~A (T (progn ~A))~%"
                                   (car c)
                                   (cadr c)))
                          (T (if (eql 'otherwise (car c))
                                 (format out
                                         "~&(T ~S)~%"
                                         `(progn ,@(cdr c)))
                                 (format out
                                         "~&#+~A (T ~S)~%"
                                         (car c)
                                         `(progn ,@(cdr c)))))))
                      (format out "~&)~%")))))
       (run))))

利用例

入れ子にもできます。

(feature-case
  (lispworks
   (feature-case 
     (lispworks7+
      (feature-case 
        (lispworks8 'foo)))))
  (otherwise nil))
→ foo

なお、読取時に存在するパッケージが処理系によってまちまちなため、マクロ展開時に存在しないパッケージを読み込んでエラーにならないようにする必要があります。
ここはポータブルには回避しようがないので、文字列で記述してもらうことにしました。

(feature-case
  ((and lispworks6 (or win32 linux))
   "(defmethod environment-p ((environment lexenv::environment))
     t)")
  ((and lispworks7+ (or win32 linux))
   "(defmethod environment-p ((environment compiler::environment))
     t)")
  (otherwise nil))

(feature-case
  (lispworks 'foo 'bar 'baz)
  (allegro "foo:foo foo:bar foo:baz")
  (otherwise 'other))

まとめ

多分、複雑な場合はファイルを処理系の条件ごとに分割してしまった方が良いでしょう。
実際、基盤になるライブラリでは結構ファイルを分割しているのを目にします。


HTML generated by 3bmd in LispWorks 8.0.0

MCLのエディタコマンドの対話的ヘルプ機能

Posted 2021-12-16 19:09:06 GMT

Lisp一人 Advent Calendar 2021 18日目の記事です。

MCLのエディタヘルプ

Emacs系エディタにはコマンドのaproposがあり、対話的にドキュメントを参照することが可能ですが、MCL(Macintosh Common Lisp)は一歩先を進んでいて、コマンド名でインクリメンタル検索ができたり、押下したキーの組み合わせで発火するコマンドを表示する機能がありました。

mcl-ed-help

おもいのほかこれが知らないコマンドを見付けたりするのに重宝します。

LispWorksだとこういうちょっとしたGUIツールを作成するのが簡単なので、練習のお題として真似して作ってみたりしています。
今回の場合は、キーの押下の検知の挙動がGUIプラットフォーム間で共通かは怪しいのですが、こういうのは大体150行くらいで書けます。
(なお、LispWorksのCAPIは共通のコードでGtk/Windows/Cocoa/Motifのマルチプラットフォームで動く筈です)

コマンド名からのインクリメンタル検索

Screenshot from 2021-12-17 04-14-25

キー組み合わせ押下での検索

Screenshot from 2021-12-17 04-13-50

そして、昨日の記事にも書きましたが、12/14日に発売となったLispWorks 8.0では似たような機能が標準装備となり、検索した結果をコマンドリストに保存できます。

LispWorks 8.0 のコマンドリスト

Screenshot from 2021-12-17 04-15-21

まとめ

最近はGUIといえば、ほとんどウェブ系技術ですが、昔ながらのGUIツールキットを使ってのGUIアプリ作成も結構面白いかなと思います。
LispWorksだとマルチプラットフォームなアプリが作成できるのでそういう用途にはお勧めです(あまりないでしょうけれど)


HTML generated by 3bmd in LispWorks 8.0.0

LispWorks 8.0発売!

Posted 2021-12-16 14:06:53 GMT

Lisp一人 Advent Calendar 2021 16日目の記事です。

アドベントカレンダーとは全然関係ない感じではありますが、LispWorks 8.0が発売になりました!
最近macOS montereyの対応パッチが出たりしていたので、まだしばらくは、LispWorks 7.1系で行くのかなと思っていたところだったので割と意外でした。 LispWorks 7.1のリリースは2017年の11月13日だったようなので、実に四年ぶりのリリースです。

目立った新機能/改善

今回、割と周囲から期待されていたようなのは、Apple Siliconにネイティブ対応したバージョンだったのですが、今回のリリースで実現されました。
M1 Macでは、グラフィック周りの性能が結構向上したようで一部で盛り上がっています。
また、生成されるアプリもユニバーサルバイナリ対応なので、現在一部でIntel vs M1でベンチを取ったりして盛り上がっています。

macOS対応以外のところでは、ホストOSとのやりとりが基本的にbase-charだったのが、UTF-8対応となり、LispWorksのShellウィンドウもやっと使い物になる感じになりました。
また、これまでは、Unixシェルなどに渡す文字列は、UTF-8の文字列をbase-charに変換して渡していたりしたのですが、これも不要となりました。
不要になったのは良いのですが、これまでのアドホックな対応は撤去しないと文字化けするので、7系以前の環境と混合する場合は注意かと思います(そんな人いないか)

その他の目立った新機能/改善は、下記くらいかなと思います。

Display Command List

MCLにあったの物と似たツールなのですが、エディタやリスナのコマンド検索のツールが増えました。
自分もMCLを真似して自作のツールを作ってみていたのですがブログに記事を書く前に自作ツールが過去の遺物となりました。

Fold Buffer Definitions

エディタで定義が畳み込み表示できるようになりました。
Emacs等ではお馴染の機能です。 Find Definitionタブで常に定義一覧があるので、あまり必要ない気もしますが畳み込みたい人もいるかもしれません。

macOSのGUIがダークモードに対応した

今の職場ではmacOSのアプリをLispWorksで作成したりしているのですが、ダークモード対応はしてないので、ダークモードの人の環境ではLispWorksアプリが浮いた表示になってました。まあ大した問題ではないんですが、用途によっては重要かもしれません。

いまのところ遭遇している問題

LispWorksのHemlockでuim-skkで日本語入力がちょっと変

Linux+GTKでuim-skkと組合せて使う場合、変換時のインライン候補の表示のされ方が割と謎挙動になっています(というか表示されない)。
どうもファイル末尾でしかインライン変換や候補がうまく表示できてない様子……。 これは自分の環境要因なのかなんなのか、まだ原因が良く分かっていません。少なくともLispWorks 7や7.1では起きておらず、またLispWorksのHemlock限定なのでエディタの新挙動との組み合わせで起きる現象のようではあります。しかしLispWorksのHemlockでガンガン日本語文章を書きたい人には解決しないとちょっと困ってしまうかもしれません。
そんな人はいないかもしれないですが、この文章もLispWorks 8.0のエディタで書いています!

以前報告したバグはどうなったか確認してみる

7.1.0は関数のボディで点対リストを受けつける

LispWorks 7.1では

(defun foo (x) x . a)

(compile nil (lambda (x) x . a))

というのを受け付け ていましたが、

Forms should not be dotted lists, but found a in (x . a).

というエラーになるようになっていました。しかし7.1.3のPersonal Editionで確認したところ同様にエラーになったので、 7.1のパッチでも修正されていたようです。気付かなかった……。

ちなみに下記のどうでも良いやつはいまだに治ってないようです。まあ内部シンボルなので……。

試用の申し込みについて

試用については、以前とまったく同じ流れでした。LispWorks 7.1.3 Personalと挙動が違うこともあるので、一応利用環境でどういう挙動になるかは購入前に確認してみた方が安心かと思います。

まとめ

LispWorksをメインで使って6年くらい経過しましたがCommon Lispの環境としては結構良いと思います。
プログラミング環境にお金を払う時代ではないといわれれば、まあそうかもしれませんが、Common Lispをメインにプログラミングをしている人であれば、購入して損はないと思います!
特にSBCLが不得意とするGUI周りは充実していますので結構根強い人気があります。

関連


HTML generated by 3bmd in LispWorks 8.0.0

Lispのシンボルにアンダーバーが使われない理由を探る

Posted 2021-12-14 19:39:20 GMT

Lisp一人 Advent Calendar 2021 15日目の記事です。

Lispのシンボル名では、単語の繋ぎとして-が多用されていることはご存知のとおりですが、他の言語では良く使われる_がLispでは使われない理由は良く分かりません。
_より読み易い-が使えるから、というのも理由にはなると思いますが、極初期のLisp Machine Lispでは、_で単語を繋いだりもしたようです。

GET_PNAME <symbol> [QFCTNS]

This works, but GET-PNAME is preferred.

MAKE_ATOM &REST <args> [QFCTNS]

This works, but MAKE-ATOM is preferred.

などですが、すぐに非推奨となり-に置き換えられたりはしたようではあります。

Lispが良く使われていた環境では_のコードが確定していなかった?

そんな_ですが、先日マッカーシー先生のHistory of Lisp(1978)の原稿をSaildartで発見したので眺めていたところ、ヒューイット先生からのメール経由でのレビューも発見しました。

このメールの中で、ヒューイット先生はメッセージ送信形式のevalというものを紹介しているのですが、

(defun lexical←apply (procedure arguments expression)
...

のように単語の繋ぎにを使っています。
これは、メッセージ送信だからかとも思ったのですが、SAILの文字コードは結構特殊なため、元の文字コード確認してみたところ、ASCIIやMITでは、_が、8進で#o137ですが、SAIL、CMU、ISIでは、文字コード#o137は、のようなのです。

つまりヒューイット先生は、MITからのメールで

(defun lexical_apply (procedure arguments expression)
...

とアンダーバー繋ぎで書いていたけれど、SAILの環境ではと表示されてしまうのではないかと推測されます(もしくはデータ復元の際にSAILコードとして復元された)

1977年当時はまだ-繋ぎも確立する程でもなかったので、_が使われたと考えると、『_は1970年代のLisp社会では、環境依存文字だったのに対し、-はどの環境でも統一されていたから好まれた』説を提唱したいところです。

ちなみに、Interlisp方面では、-繋ぎではなく、代りに.繋ぎが良く使われました。 これも謎ですが、clispという自然言語風記法で1+x1-xと記述できたため、曖昧さを避けて、lexical.applyのように記述することにしたのかなと想像しています。

関連


HTML generated by 3bmd in LispWorks 7.0.0

Lispと漢語

Posted 2021-12-13 19:28:52 GMT

Lisp一人 Advent Calendar 2021 14日目の記事です。

Lispと漢語、というより、中国語訳のLisp用語なのですが、邦訳用語ではあまり座りが良くなかったり、カタカナでやたら長かったりするものが簡潔に訳されていたりするので、ちょっと集めてみました。

マクロ
リーダーマクロ
読取宏
destructuring/分配
解構
スロット
リスト
列表
空リスト
空列表
クォート(引用符)
引号
バッククォート
反引号
パッケージ
アナフォリックマクロ
指代宏
シンボル
符号
インターン
扣押
アンインターンドシンボル
自由的符号
ローカル関数
区域函数
総称関数
通用函数
一般化参照
通用化引用

まとめ

どうでしょうか。アナフォリックマクロが中国語だと、指代宏という三文字になんですよね。 個人的には、読取宏、解構、反引号、あたりは短かくなるので結構好みです。
ちなみに、アンインターンドシンボルなどは、自由シンボルと訳しても良いんじゃないかと以前から思ったりはしています。

参考文献


HTML generated by 3bmd in LispWorks 7.0.0

Common Lispのメタクラスに関してはLOOPSからの影響が大かもしれない

Posted 2021-12-12 20:23:45 GMT

Lisp一人 Advent Calendar 2021 13日目の記事です。

どうやら、Common Lispのメタクラスに関してはLOOPSからの影響が大きいらしい、というか、Common Lispに先行するオブジェクト指向システムの中でメタクラスを持っているものがLOOPS(→CommonLoops)位なので、そりゃそうだろう、というところなのかもしれません。

最近、主にLOOPS方面からオブジェクト指向プログラミングを解説した文献を読んでいたのですが、LOOPSでは1980年代前半からメタクラスをmixinして使うようなことが行なわれていたようです。

LOOPSのソースが公開されているので、少し眺めてみると、マニュアルに記載がある基本的なメタクラスの定義をみつけることができました。

  • LOOPS Manual (3)

  • https://github.com/Interlisp/loops/blob/main/users-src/LOOPSMIXIN

DatedObject を真似てみる

何やら謎めいたものが多いのですが、オブジェクトに日付と作成ユーザーのデータを入れこむDatedObjectという定義があるので、これをCommon Lispで真似してみましょう。

;;; LOOPS
(DEFCLASS DatedObject
   (MetaClass Class doc "Mixin to record the creator and date of creation for objects." Edited%: 
                                                             (* RBGMartin "19-Feb-87 14:21"))
   (Supers Object)
   (InstanceVariables (created NIL %:initForm (DATE)
                             doc "date and time of creation of object")
          (creator NIL %:initForm (USERNAME)
                 doc "USERNAME of creator of object")))

Common Lisp版

使われ方が良く分からないのですが、こんな感じに書けるでしょう。

(defun user-name ()
  #+lispworks
  (sys:get-user-name)
  #-(or lispworks)
  (car (last (pathname-directory (user-homedir-pathname)))))

(defun date () (multiple-value-bind (.s .m .h d m y) (cl:get-decoded-time) (format nil "~D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D" y m d .h .m .s)))

(defclass dated-class (standard-class) ())

(defmethod validate-superclass ((c dated-class) (s standard-class)) T)

(defclass dated-object (standard-object) ((created :initform (date) :documentation "date and time of creation of object") (creator :initform (user-name) :documentation "USERNAME of creator of object")) (:metaclass dated-class) (:documentation "Mixin to record the creator and date of creation for objects."))

(describe (make-instance 'dated-object))
#<dated-object 408019AFD3> is a dated-object
created      "2021-12-13T05:10:11"
creator      "mc"

このDatedObjectに関しては、standard-objectのサブクラスにするだけで良いのですが、なんとなく別のメタクラスにしてみました。 しかし、一体これをどう使うんだ……。

まとめ

Common LispはもともとMACLISP系のLispをまとめたものなので、オブジェクト指向システムについてもMIT系のFlavorsの影響が大なようではありますが、実際の中身は割とXerox系のオブジェクト指向システムな気がしています。
案外、Flavorsはメソッドコンビネーションや構文等、コードとして目に付く表面的なところに影響が大きいのかもしれません。
ちなみに、メタオブジェクトプロトコルのように一連のメソッドを規約として構成するプロトコルという概念もLOOPS方面のオブジェクト指向システムではお馴染みの手法だったようです。
この辺りのことが書いてある、上述のObject-Oriented Programming: Themes and Variationsは面白いのでお勧めです。


HTML generated by 3bmd in LispWorks 7.0.0

(the ignore x)ってどうだろう

Posted 2021-12-11 21:00:56 GMT

Lisp一人 Advent Calendar 2021 12日目の記事です。

手元のネタ帳に『(the ignore x)ってどうだろう』とメモがあるのですが、declaretheの類似性から(the ignore ...)と書けても良いんじゃないか、ということだと思います。
さてどうでしょうか。

手抜き実装では、こんな風に書けるかと思いますが、

(defpackage ignore 
  (:use cl)
  (:shadow the))

(in-package ignore)

(defmacro the (value-type form) (case value-type (cl:ignore (when (typep form 'symbol) `(progn ,form (values)))) (otherwise `(cl:the ,value-type ,form))))

(mapcar (lambda (x y) (the ignore x) y) '(a b c d e) '(0 1 2 3))(0 1 2 3)

そもそもtheは値を返す場所という印象なので、この点でいまいちですね。

ちなみに、古くは、MACLISPやLisp Machine Lispにignoreというのがあり、これと殆ど同じです。
そういえばと思って確認してみたら、Emacs Lispにもありました(interactive関数ですが) さらにちなむと、the形式はInterlisp由来らしいです。

(mapcar (lambda (x y)
          (ignore x)
          y)
        '(a b c d e)
        '(0 1 2 3))(0 1 2 3)

これだったら、λリストで&ignoreとでもした方が便利そうなので、試してみました。

(defun process-&ignore (lambda-list)
  (let ((ignores '()))
    (labels ((collect-&ignore (tree)
               (cond ((null tree) nil)
                     ((consp (car tree))
                      (cons (collect-&ignore (car tree))
                            (collect-&ignore (cdr tree))))
                     ((eq '&ignore (car tree))
                      (push (cadr tree) ignores)
                      (collect-&ignore (cdr tree)))
                     (T (cons (car tree)
                              (collect-&ignore (cdr tree)))))))
      (values (collect-&ignore lambda-list)
              ignores))))

(defmacro fn ((&rest args) &body body) (multiple-value-bind (args ignores) (process-&ignore args) `(lambda (,@args) (declare ,@(if ignores `((ignore ,@ignores)) '())) ,@body)))

(mapcar (fn (&ignore x y) y)
        '(a b c d e)
        '(0 1 2 3))(0 1 2 3)

;; (declare (ignore))を良くつかうところ (set-macro-character #\? (fn (stream &ignore char) `(print ,(read stream T nil T))))

まとめ

&ignoreのほうは、割と使えるかも?
しかし、既存のlambda-list-keywordsでは、基本的にcdr方向全部に指定がかかるので、直後の変数にのみ効くというのは、違和感があるかも。

関連


HTML generated by 3bmd in LispWorks 7.0.0

(eql ...)型を活用したい

Posted 2021-12-11 14:03:25 GMT

Lisp一人 Advent Calendar 2021 11日目の記事です。

Common Lispには任意のオブジェクトから型指定子を作ることが可能です。 こんな風に使えますが、

(typep 1 '(eql 1))
→ t

deftypeで名前を付けることも可能です。

(deftype one ()
  `(eql 1))

(typep 1 'one) → t

規格には規定されていませんが、このdeftypeに閉じ込められたオブジェクトを取り出す機能は大抵の処理系にあります。 (取り出せないと比較ができないので)

;;; LispWorksの場合
(type:expand-user-type 'one)(eql 1)
  t

これを活用して何かできないでしょうか。

ちょっと思い付くのは、大域変数の代わりにdeftypeを使う、というもの。 下記はend-of-fileをdeftypeだけでどうにかできないか考えてみた例ですが、使い勝手はいまいちです。

(let ((eof '#:eof))
  (deftype eof ()
    `(eql ,eof))
  (defun the-eof ()
    eof))

(with-input-from-string (in (format nil "~{~A~%~}" '("foo" "bar" "baz"))) (loop :for line := (read-line in nil (the-eof)) :until (typep line 'eof) :collect line))("foo" "bar" "baz")

シングルトン系の操作で活躍できそうなのですが、何か良い活用方法はないでしょうか。
何か思い付いたらこのブログに書きます。


HTML generated by 3bmd in LispWorks 7.0.0

デフォルト値付きのsetf

Posted 2021-12-09 21:39:32 GMT

Lisp一人 Advent Calendar 2021 10日目の記事です。

普段利用している便利構文として、Gaucheの~が元になったsrfi-123~/refのCommon Lisp版を定義して利用しているのですが、refの方にはデフォルト値が指定できるのですが、refの便利表記マクロである~では指定ができません。

何故かというと複数引数の場合には、多段のrefに展開するからなのですが、これはこれで便利です。

(~ place 0 1 2)
===>
(ref (ref (ref place 0) 1) 2)

色々考えましたが、デフォルト値指定の慣用句である、orと組合せた場合にデフォルト値付きの展開になれば良いのではないか、ということで試してみました。具体的には、setfの場所としての

(or (~ tab 'a) default)

のようなフォームが、

(ref tab 'a default)

と展開されればOKです。

(setf or) の定番定義

(setf or)はANSI CL規格では定められていないので、サポートされているとすれば処理系の独自拡張になりますが、CLISPが(setf if)をサポートしているのでifの組合せで表現できるorも結果としてサポートされることになります。

CLISPの場合は、orの返り値の場所がsetfの場所となるようです。 つまり、

(or place place place)という風になります。

デフォルト値指定ありのsetfの場所

今回の場合は、orを含めてplaceとしたいので、別途定義する必要がありそうです。 ということで、こんな風に書いてみました

(define-setf-expander or (place default &environment env)
  (multiple-value-bind (temps subforms stores setterform getterform)
                       (get-setf-expansion place env)
    (values temps subforms stores setterform `(,@getterform ,default))))

これで、

(let* ((tab (make-hash-table))
          (subtab (make-hash-table)))
  (setf (~ tab 'sub) subtab)
  (incf (or (~ tab 'sub 'subkey) 0))
  (~ tab 'sub 'subkey))
→ 1
  t

は、

(let* ((tab (make-hash-table)) 
       (subtab (make-hash-table)))
  (let* ((#:g9763 tab) (#:g9764 'sub) (#:|Store-Var-9762| subtab))
    (setf_ref #:|Store-Var-9762| #:g9763 #:g9764))
  (let* ((#:g9766 (ref tab 'sub)) (#:g9767 'subkey))
    (let* ()
      (lisp:let ((#:|Store-Var-9765| (+ (ref #:g9766 #:g9767 0) 1)))
        (setf_ref #:|Store-Var-9765| #:g9766 #:g9767))))
  (ref (ref tab 'sub) 'subkey))

のように展開されます。


HTML generated by 3bmd in LispWorks 7.0.0

defconstantのeql問題について別解を考えた

Posted 2021-12-08 19:51:49 GMT

Lisp一人 Advent Calendar 2021 9日目の記事です。

主にSBCLで発生する問題なのですが、ANSI規格を厳格に解釈した結果、defconstanteqlな関係でないオブジェクトを定数として再定義するとエラーになるというのがあります。

これはOKですが、

(progn
  (defconstant foo-constant 42)
  (defconstant foo-constant 42))

これはNG。

(progn
  (defconstant bar-constant "bar")
  (defconstant bar-constant "bar"))
!>> The constant bar-constant is being redefined (from "foo" to "foo")

SBCL対策

この問題の対策として、再定義しないで値を使い回すようなマクロが良く使われたりしています。
例えば、cl-ppcre::defconstantは、

(ppcre::defconstant bar-constant "bar")
===>
(defconstant bar-constant (if (boundp 'bar-constant) (symbol-value 'bar-constant) "bar"))

のようにして問題を回避します。

さらに汎用的なものでは、alexandria:define-constantのように同値テストを指定できるものもあります。

(define-constant bar-constant "bar" :test #'equal)

他にも結構同様の問題に対処するユーティリティが結構あります。

最近考えた別解

これらは、(boundp 'var)でシンボルをチェックするのですが、開き直って、

(defvar .baz-constant. "baz")

(defconstant baz-constant .baz-constant.)

のように書いてしまっても良いのではないかと最近思ったりしています。 defvarは値の唯一性/再定義回避の担保で、defconstantは、定数の定義のみ、と役割分担しているのだ考えれば、そこまで変でもないのではないでしょうか。

ちなみに、.foo.というドットで囲む表記はSymbolics等ではユーザーはいじってはいけない変数名という慣習だったようですが、このような命名規約を定める程度でトラブルも回避できそう(多分)

まとめ

ちなみにSBCL以外の処理系は、そこまで厳しくないので、(defconstant foo "foo")していても特に問題はありません。
とはいえ、SBCLが現在最大派閥であることは確かなので、自作ライブラリを公開する場合などにはSBCL対応を避けて通ることもできません。

defconstanteqlを求めるのはコンパイルコードに即値として埋め込む等の最適化周りとも関係してくるので、基本的にCommon Lispで定数といったらeqlで同値判定可能なオブジェクトと考えた方がすっきりする気がします。

そう考えると、文字列の場合は、

(defconstant ztesche-constant (string '|ztesche|))

のような記述もアリかもしれません。しかし、少し難解かもしれない……。


HTML generated by 3bmd in LispWorks 7.0.0

漸進的型付けとCommon Lisp

Posted 2021-12-07 21:44:40 GMT

Lisp一人 Advent Calendar 2021 8日目の記事です。

五六年に漸進的型付けというのが若干流行った気がするのですが、今はどうなっているのでしょう。
Pythonに型アノテーションを付けて書くようにするようなことは今の職場でも行なっているので、実はそこそこ身近になってきているのでしょうか。

Common Lispは漸進的型付け(を先取りしていた)か

この概念を知った時に、普段Common Lispを書いてる感覚そのままじゃないかと思ったのですが、<漸進的型付け>という型システムとのことなので、似たようなものなのか、全然違うものなのか。
久し振りに<漸進的型付けとは何か>のページを眺めたら、

『いくつかの言語は、すでにオプションの型アノテーションを持っていますが、
...オプションの型アノテーションを持つ言語には Common LISP, Dylan, Cecil, Visual Basic.NET, Bigloo Scheme, Strongtalk 
があります。漸進的型付けは、これらの言語がオプションの型アノテーションで何をするかについての基盤を提供することを意味します。』

という風にCommon Lispにも言及されていました。やはり似たようなものなのだろうか。

Common Lispは漸進的型付けではない

<漸進的型付けとは何か>を読み進めていっても、Common Lispと漸進的型付けの関係はいまいち分からなかったので、筆者の論文にあたってみたところ、元はScheme and Functional Programming Workshop 2006で発表したもののようです。
なんだ元はLisp畑の研究なのかと思ったりもしましたが、

Bigloo Schemeは漸進的型付け的なものを持つが、

Several programming languages provide gradual typing to some
degree, such as ...and the Bigloo dialect of Scheme 

Common Lispは持たないとあります。

Common LISP and Dylan include optional type annotations, but the annotations are not used for type checking, they are used to improve performance.

Common Lispは、実行効率を上げるための指定でありチェック機構ではない、ということですが、それはそれで納得です。

一応Biglooのマニュアルを確認してみると

2.8 Type annotations
Type information, related to variable or function definitions, can be added to the source code. If no type information is provided, runtime checks will be introduced by the compiler to ensure normal execution, provided that the user has not used compilation flags to prevents this. If type information is added, the compiler statically type checks the program and refuses ones that prove to be incorrect.

とのことで、Common LispでいうとSBCL等の処理系の使用感ともそんなに変わらない気がします。

さてこの『いや、Common Lispもコンパイル時に型チェックしてくれるではないか?』という感覚はどこに由来するのか。
これは以前にこのブログにも書きましたが、実はCMUCL系のPythonコンパイラで(declare type)の宣言をコンパイル時の型チェックに扱う拡張が現在では主流になっているため、Common Lispもコンパイル時の静的チェックサポートしている、という印象が強くなったのではないでしょうか。

ちなみに、Allegro CLも1990年代にこの流れに乗っていたと思います(文献があった憶えがあるが資料見付からず)

まとめ

いろいろ書きましたが、Siek氏らが提唱する漸進的型付けは、静的/動的のハイブリッドな型チェックを体系化したものなので、Common Lispが漸進的型付けをサポートするということであれば、この体系を取り込む必要があると思われます。

とはいえ、2021年の現状では型アノテーション付きのPythonよりはSBCL等のCommon Lisp処理系の方が開発時の静的チェックが効きますし実用的だなという印象です。

※なおチェックのためにはセッティングが重要なので適切に設定しましょう。
開発時は、

(proclaim '(optimize (debug 3) (safety 3)))

あたりにしておくと大抵の処理系で結構チェックは効くと思います。


HTML generated by 3bmd in LispWorks 7.0.0

Lispとイメージのダンプについて

Posted 2021-12-06 17:15:06 GMT

Lisp一人 Advent Calendar 2021 7日目の記事です。

今回は言語処理系の機構としてはマイナーなイメージのダンプについて書いてみたいと思います。

イメージのダンプとは

処理系のメモリの状態をファイルに書き出せるという機能です。
イメージ指向の言語というと、Smalltalkが有名ですが、Common Lispでも普通に活用可能です。

手短な活用法としては、沢山ライブラリをロードする場合の時間短縮等があるかと思います。 過去にこのブログでも1800位のライブラリをロードしてダンプしてみる、というのを試したりしたことがありますが、当たり前ですがこういう場合は圧倒的な時間短縮になります。

このイメージのダンプですが、何故かネガティブなイメージを持っている人がそこそこいるようなのが不思議なのですが、単純にいえば、コンパイル済みのfaslファイルを読み込んだ状態で処理系を起動するか、起動してからfaslを読むかの違いくらいしかありません。
また、ダンプ自体も、save-imageであったり、save-lisp-and-dieであったりでファイルに書き出すだけなので、身構える程のものでもありません。いまどきの喩えでいうならdocker imageの作成みたいなものかと思います。

個人的には一日の作業前に作業用のイメージを作成して、それを立ち上げて作業していますが、毎時間のように知らないライブラリをロードするようなことはないことを考えるとコンパイルとロードの時間を短縮できますし便利かなと思います。

もっと便利になって欲しいところ

LispWorksのようなIDEであれSLIMEであれ、大抵は処理系はマルチスレッドで稼働しているのですが、イメージのダンプはシングルスレッドの状態で実行しなければいけないことが殆どです。
スレッドを終了して、シングルスレッドにするユーティリティでも書いて実行すれば良いのですが、VirtualBoxのような仮想マシンの停止や再開作業やスナップショットが取れると便利だろうなとは思います。
Interlisp-Dは、まさにそのような環境で、(sysout '{dsk})とすれば、ディスクにイメージが保存されるので、マシンを落して再起動すれば、その状態から再開、ということが可能でした。

Common Lispのイメージ指向はどこから来た?

MACLISPはファイル指向でしたが、MIT Lispマシンはイメージ指向へと移行しディスクの特定の領域にブートイメージを書き出すというスタイルでした。 Interlisp-Dは完全にイメージ指向なのですが、先祖のBBN LISPでは1967年からsysoutは存在するようです。
Lispにおいては、開発環境=OSというのはBBN LISPが元祖かなと思いますが、XEROXでは、Smalltalkと共にイメージ指向というのが結構発展したようです。
(ちなみに他にもイメージ指向の言語ってあるのでしょうか)

さて、Common Lispにイメージ指向を取り入れる必然性はあったのかと疑問が湧いてきますが、Common Lispでは1980年代中頃からマシンリソースの割にはコンパイル&ロードに何時間も掛るような重い作業をすることが多かったようなので、コンパイル済のイメージを保存しておくのは、かなりの時間の節約になったのかなと想像します。

まとめ

折角の機能なのでイメージのダンプを活用しましょう!


HTML generated by 3bmd in LispWorks 7.0.0

Lispを書くのにEmacsを使わない人

Posted 2021-12-05 18:37:05 GMT

Lisp一人 Advent Calendar 2021 6日目の記事です。

ブログに書けそうなネタを思い付いたらメモっておくネタ帳のようなものがあるのですが、『Lispを書くのにEmacsを使わない人』というお題で何か記事を書いてみたいと思ってから6年半経ちました。
そんな6年半の間に、古き良きvim(vi) vs. Emacs のような構図どころではなく、エディタ界はいつの間にかVS Codeが席巻しつつあります。

結局のところLispエディタには何が必要なのか

とりあえず、エディタ人気には栄枯盛衰がありますが、Lispの編集について必須要件というのは昔からあまり変っていません。
また、この必須要件を無視したようなエディタ議論をしてもLisp編集についてはあまり資するところがないかと思います。

ということで基本的な必須機能をまとめてみました。

Lisp開発で必須なエディタの機能

基本機能

  • S式単位での移動
  • S式単位での編集(括弧の対応サポート含む)/コピー&ペースト&削除
  • S式ツリーの根から葉、葉から根方向への移動

Lispとの連携

  • マクロ展開
  • オブジェクトのインスペクタ
  • シンボル等の補完
  • クロスリファレンス
  • 定義の取消し(defun、defmethod、defclass等の取消し機能)

ドキュメント参照

  • 規格を参照する機能(HyperSpec参照等)

大体上記が整備されていれば、どんな環境でも良いと思いますが、Common Lisp界隈で好まれているSLIMEは、上記を大体満足なレベルでクリアしているので、SLIMEを勧める人が多いと思います。
加えて、新興のエディタでは、Lisp固有のサポートはなかなか整備されない傾向が強いので、S式の移動と、マクロ展開あたりは、SLIME等に比べれば貧弱です。
そのため、SLIMEを知っている人からするとSLIME一択という感じなのですが、Lispの対話的開発自体に馴染みがない人達からするとメリットがいまいちわからず、何やら考えの凝り固まった人達が勧めているもの、という目で見られている気がしないでもありません。
さらにいうと、Symbolicsを始めとしたLispマシンの開発環境がありますが、SLIME利用者でさえ、考えの凝り固まった懐古主義者が勧める謎環境という眼差しを向けているような気がします。
実際のところ非常に強力な環境だったので、以後のLispの開発環境は多かれ少なかれSymbolicsの環境を再現しようとしていたといっても過言ではないのですが、この辺りにも断絶があるように思います。

まとめ

新しいから良い、古いから駄目というのではなく、単純に実現したい機能で比較すれば、それなりに妥当な評価が得られると思うのですが、実際に環境を並べて比較するようなレビューは殆ど目にしたことがない気がします。この辺りが問題なのかもしれません。

また、Lisp固有の開発ツールについて解説していることも少ないので、長年Lisp開発をしていても、マクロ展開はREPLでmacroexpand式を実行している、という人も割と珍しくなかったりしますので、多分、詳細な解説の書籍かなにかが求められているのでしょう。 といってもマイナーすぎて採算取れなさそう。


HTML generated by 3bmd in LispWorks 7.0.0

Lispと若者

Posted 2021-12-04 17:38:39 GMT

Lisp一人 Advent Calendar 2021 5日目の記事です。

若い世代の新規参入が進まないためか今となってはLispやってるのは中高年の人達というイメージですが、まあ最初からそうではなかった筈だと思い、Lisp的なイノベーションと若者という視点で並べてみました。

Lispの処理系草創期

当初Lispは当時の他の言語と同じくコンパイラ言語として構想されていましたが、evalの定義をみて、そのままインタプリタとして動かせるんじゃないかと思って実装してしまったのが、Steve Russell氏です。 1937年生れとのことなので1960年付近では大体23歳でしょうか。

1963年にPDP-1 LISPを作ったL Peter Deutsch氏は、当時17歳だったそうです。PDP-1 LISPは初の対話的LISPともいわれています。

日本のLisp草創期としては、中西正和氏がKLISPを開発していたのは、22〜24歳頃のようです。

MACLISP

今のCommon Lispに直接繋がるMACLISP(PDP-6 LISP)が登場したのは、1965年あたり。主要開発者のRichard Greenblatt氏は当時大体22歳位。 ちなみに、チェストーナメントに出場できるレベルのMac Hackチェスプログラムを開発したのも大体同じ時期です。しかしプログラミングに熱中しすぎて大学はドロップアウトしてしました。

Multics MACLISPのメイン開発者だった、David A. Moon氏は、当時学部生ということなので、21〜2歳でしょうか。

Scheme

Schemeの生みの親の一人のGuy L. Steele Jr.氏は、当時21歳位。
Scheme開発の前から、MACLISPのメンテナを引き受ける等Lisp畑では活躍していました。

Lispマシン界隈

Lispで書かれた初のEmacsのメイン開発者だった、Daniel Weinreb氏がEINE、ZWEIを書いたのが18〜9歳。

Franz Lisp界隈

Franzの共同設立者のJohn Foderaro氏らが1980年Franz Lispを作ったのは、大学生〜大学院生とのことなので、二十代前半から中頃でしょうか。 ちなみに、RISCの開発にも関わりが深いようです。

Common Lisp界隈

仕様策定のコアメンバーとして5名が挙げられますが、CLtL1の1984年当時で、

です。言語規格策定のコアメンバーとしては若いのではないでしょうか。

その他

RMSもGLSと同世代で、MIT Lispハッカー文化の最盛期は、1980年代前半あたりに、二十代中半あたりを迎えた人達が活動していたという感じですね。

まとめ

1980年代にコンピューター雑誌を読んでいた身としては、思えば昔は、プログラミングは若者(特に十代)がするもの、という印象が強かった気がします。 プログラマという職業が一般に広まるにつれ平均的な年齢層も上がってきたように思うので、時代も反映されているという気がしないでもないですが、それでも活発な時期にはLispも若者中心に動いているという感じですね。


HTML generated by 3bmd in LispWorks 7.0.0

ウェブページのスクレイピングにプロダクションシステムを使ってみる

Posted 2021-12-04 10:09:33 GMT

Lisp一人 Advent Calendar 2021 4日目の記事です。

以前、ウェブページのスクレイピングをProlog(後ろ向き推論)で試してみましたが、今回はプロダクションシステム(前向き推論)で試してみます。

プロダクションシステムは、基本的な考え方としては、所謂IF-THENのルールが並んでいるもので、一般的な会話での『ルールベース』というとこういうものを想像していることが多いようです。
実際の前向き推論のシステムは、IF-THENの列挙というわけではなく、もっと効率の良いアルゴリズムが使われています。 今回試すlisaは、プロダクションシステムとして有名なOPS5系でReteアルゴリズムをベースにしています。

しまむらのページをスクレイピングしてみる

今回試すのは、

  1. 適当なカテゴリの商品一覧ページから商品画像を取り出す
  2. 商品検索ページから商品名で検索して該当した商品画像を取り出す

です。

こんな風に書けました。

(ql:quickload '(clss plump dexador lisa drakma))

(defpackage "40219287-1ccc-5a4a-967b-8efb315e9701" (:use cl lisa) (:shadowing-import-from lisa assert))

(in-package "40219287-1ccc-5a4a-967b-8efb315e9701")

(defmethod initialize-instance :after ((inst plump::node) &rest args &key) (assert-instance inst))

(defcontext :site-query) (defcontext :page-query)

(defclass shimamura-fundamental () ())

(defclass site-query (shimamura-fundamental) ((word :initform nil :initarg :word) (page :initform nil :initarg :page)))

(defrule query-by-word (:context :site-query) (?site-query (site-query (word ?word) (page ?page))) (test (null ?page)) => (modify ?site-query (page (plump:parse (dex:get (fstring "https://www.shop-shimamura.com/disp/itemlist/?q=~A" (quri:url-encode ?word)))))))

(defclass page (shimamura-fundamental) ((is :initform nil)))

(defrule get-page (:context :page-query) (?page (page (is ?html))) (test (null ?html)) => (let ((?html (plump:parse (dex:get "https://www.shop-shimamura.com/disp/itemlist/001002001/")))) (modify ?page (is ?html))))

(defclass card__thumb (shimamura-fundamental) ((is :initarg :is)))

(defrule collect-card__thumb () (plump:element (:object ?e)) (test (equal (plump:attribute ?e "class") "card__thumb")) => (assert (card__thumb (is ?e))))

(defclass img (shimamura-fundamental) ((is :initform nil :initarg :is)))

(defrule collect-img () (card__thumb (is ?e)) => (let ((win (first (plump:get-elements-by-tag-name ?e "img")))) (when win (let ((?img (make-instance 'img :is win))) (assert (?img))))))

(defrule print-result () (img (is ?img)) => (format T "~A: ~A~%" (plump:attribute ?img "alt") (plump:attribute ?img "src")))

OPS5系の作法ではルール発火の火口を別途定義することが多いようなので、startupとして定義し、それをrunに与えてそれぞれ実行してみます。

(defrule startup (:context :page-query)
  =>
  (assert (page)))

(defrule startup (:context :site-query) => (lisa::with-context :site-query (assert ((make-instance 'site-query :word "メンズ ボクサーブリーフ(しまむらロゴ)")))))

実行

(progn
  (reset)
  (run '(:site-query)))
▻ メンズ ボクサーブリーフ(しまむらロゴ): https://img.shop-shimamura.com/items/images/01/0140200003750/01_0140200003750_201_l.jpg
▻ メンズ ボクサーブリーフ(しまむらロゴ): https://img.shop-shimamura.com/items/images/01/0140200003749/01_0140200003749_201_l.jpg

(progn (reset) (run '(:page-query))) ▻ メンズ キャラクターパーカ(TVアニメ「ヴィジュアルプリズン」): https://img.shop-shimamura.com/items/images/01/0128200005473/01_0128200005473_312_l.jpg ▻ メンズ キャラクターパーカ(TVアニメ「ヴィジュアルプリズン」): https://img.shop-shimamura.com/items/images/01/0128200005472/01_0128200005472_309_l.jpg ▻ メンズ キャラクターパーカ(TVアニメ「ヴィジュアルプリズン」): https://img.shop-shimamura.com/items/images/01/0128200005471/01_0128200005471_213_l.jpg ▻ メンズ キャラクターパーカ(TVアニメ「ヴィジュアルプリズン」): https://img.shop-shimamura.com/items/images/01/0128200005470/01_0128200005470_107_l.jpg ▻ メンズ キャラクタートレーナー(はぴだんぶい): https://img.shop-shimamura.com/items/images/01/0123200007192/01_0123200007192_213_l.jpg ▻ メンズ キャラクタートレーナー(スーパーシロ×サンリオキャラクターズ ): https://img.shop-shimamura.com/items/images/01/0123200007191/01_0123200007191_307_l.jpg ▻ メンズ キャラクタートレーナー(TVアニメ「ヴィジュアルプリズン」): https://img.shop-shimamura.com/items/images/01/0123200007166/01_0123200007166_312_l.jpg ▻ メンズ キャラクタートレーナー(TVアニメ「ヴィジュアルプリズン」): https://img.shop-shimamura.com/items/images/01/0123200007165/01_0123200007165_107_l.jpg ▻ メンズ キャラクタートレーナー(TVアニメ「ヴィジュアルプリズン」): https://img.shop-shimamura.com/items/images/01/0123200007164/01_0123200007164_213_l.jpg ▻ メンズ キャラクタートレーナー(TVアニメ「ヴィジュアルプリズン」): https://img.shop-shimamura.com/items/images/01/0123200007163/01_0123200007163_309_l.jpg ▻ メンズ ビッグシルエットパーカ(U.S.POLO ASSN.): https://img.shop-shimamura.com/items/images/01/0123200007169/01_0123200007169_312_l.jpg ▻ メンズ ビッグシルエットパーカ(U.S.POLO ASSN): https://img.shop-shimamura.com/items/images/01/0123200007168/01_0123200007168_213_l.jpg ▻ メンズ ビッグシルエット裏起毛トレーナー(U.S.POLO ASSN.): https://img.shop-shimamura.com/items/images/01/0123200007167/01_0123200007167_312_l.jpg ▻ メンズ ビッグシルエット裏起毛トレーナー(U.S.POLO ASSN.): https://img.shop-shimamura.com/items/images/01/0123200007167/01_0123200007167_105_l.jpg ▻ メンズトレーナー(天下一品): https://img.shop-shimamura.com/items/images/01/0128200005491/01_0128200005491_213_l.jpg ▻ メンズトレーナー(天下一品): https://img.shop-shimamura.com/items/images/01/0128200005490/01_0128200005490_211_l.jpg ▻ メンズ トレーナー(天下一品): https://img.shop-shimamura.com/items/images/01/0123200007162/01_0123200007162_213_l.jpg ▻ メンズ トレーナー(天下一品): https://img.shop-shimamura.com/items/images/01/0123200007161/01_0123200007161_211_l.jpg ▻ メンズ フリースジャケット(LATOK): https://img.shop-shimamura.com/items/images/01/0123700000728/01_0123700000728_213_l.jpg ▻ メンズ フリースジャケット(LATOK): https://img.shop-shimamura.com/items/images/01/0123700000728/01_0123700000728_105_l.jpg ▻ メンズ 裏起毛刺しゅうトレーナー(LATOK): https://img.shop-shimamura.com/items/images/01/0123200007126/01_0123200007126_211_l.jpg ▻ メンズ 裏起毛トレーナー: https://img.shop-shimamura.com/items/images/01/0123200007125/01_0123200007125_307_l.jpg ▻ メンズ キャラクター裏ボアトレーナー(Disney): https://img.shop-shimamura.com/items/images/01/0123200006894/01_0123200006894_106_l.jpg ▻ メンズ ビッグシルエットブルゾン: https://img.shop-shimamura.com/items/images/01/0123600000729/01_0123600000729_208_l.jpg ▻ メンズ ビッグシルエット裏起毛パーカ: https://img.shop-shimamura.com/items/images/01/0123200006854/01_0123200006854_211_l.jpg ▻ メンズ中綿アウター(風早ゆうた): https://img.shop-shimamura.com/items/images/01/0123600000736/01_0123600000736_112_l.jpg ▻ メンズ中綿アウター(風早ゆうた): https://img.shop-shimamura.com/items/images/01/0123600000736/01_0123600000736_314_l.jpg ▻ メンズフリーストレーナー(風早ゆうた): https://img.shop-shimamura.com/items/images/01/0123200007100/01_0123200007100_111_l.jpg ▻ メンズフリーストレーナー(風早ゆうた): https://img.shop-shimamura.com/items/images/01/0123200007100/01_0123200007100_314_l.jpg ▻ メンズ レイヤード風裏起毛トレーナー: https://img.shop-shimamura.com/items/images/01/0123200007027/01_0123200007027_214_l.jpg ▻ メンズ レイヤード風裏起毛トレーナー: https://img.shop-shimamura.com/items/images/01/0123200007027/01_0123200007027_107_l.jpg ▻ メンズ ファーブルゾン(中島健): https://img.shop-shimamura.com/items/images/01/0123600000755/01_0123600000755_211_l.jpg ▻ メンズ ファーブルゾン(中島健): https://img.shop-shimamura.com/items/images/01/0123600000752/01_0123600000752_213_l.jpg ▻ メンズ シャギーベスト(LOGOS DAYS): https://img.shop-shimamura.com/items/images/01/0121100000530/01_0121100000530_315_l.jpg ▻ メンズ シャギーベスト(LOGOS DAYS): https://img.shop-shimamura.com/items/images/01/0121100000530/01_0121100000530_105_l.jpg ▻ メンズ 裏起毛プルパーカ(新日本プロレス): https://img.shop-shimamura.com/items/images/01/0120800000748/01_0120800000748_111_l.jpg ▻ メンズ 裏起毛トレーナー(新日本プロレス): https://img.shop-shimamura.com/items/images/01/0120800000747/01_0120800000747_312_l.jpg ▻ メンズ 裏起毛トレーナー(新日本プロレス): https://img.shop-shimamura.com/items/images/01/0120800000746/01_0120800000746_213_l.jpg ▻ メンズ キャラクター裏起毛パーカ(Peko&Poko): https://img.shop-shimamura.com/items/images/01/0123200006941/01_0123200006941_213_l.jpg ▻ メンズ トレーナー(GERRY cosby): https://img.shop-shimamura.com/items/images/01/0123200006905/01_0123200006905_212_l.jpg ▻ メンズ トレーナー(GERRY cosby): https://img.shop-shimamura.com/items/images/01/0123200006904/01_0123200006904_306_l.jpg ▻ メンズ 裏起毛トレーナー(ecko unltd.): https://img.shop-shimamura.com/items/images/01/0123200006885/01_0123200006885_213_l.jpg ▻ メンズ 裏起毛トレーナー(ecko unltd.): https://img.shop-shimamura.com/items/images/01/0123200006885/01_0123200006885_315_l.jpg

ちなみに、lisaではtraceに相当するwatchが使えて、ルールがどのように発火したかを確認できます。

(watch :activations)
(watch :facts)
(watch :rules)

まとめ

IF-THENレベルで記述できるような簡単なルールだと、記述が面倒なだけですが、そこそこ複雑になれば、プロダクションシステムのようなものも活躍できるのかなと思います。
とりあえず、プロダクションシステムのプログラミングの作法に馴染みがないと全然思ったように記述ができないですね。


HTML generated by 3bmd in LispWorks 7.0.0

祝bit電子復刻 & bitのLisp記事まとめ

Posted 2021-12-01 22:04:18 GMT

Lisp一人 Advent Calendar 2021 2日目の記事です。

bitは1969年から2001年まで刊行されていた、コンピューター科学寄りのコンピューター誌でした。
Lispの記事も豊富にあるのですが、その他の記事も非常に興味深い内容で今読んでも面白い内容です。
復刊の声も強かったのですが、この度イースト株式会社の尽力により電子復刻となったようです。 素晴らしい!

bitには古くは後藤英一先生のLISP連載等に始まり、今読んでも面白いLisp記事が沢山あります。
以前から日本で出版されたLisp本の目録を恐らく数十〜百時間という無駄な時間を掛けて作成していましたが、bit電子版復刻によりついに火を吹く時が来たようです。
このまとめには、bit以外の本も載っていますが、ページ内で適当に検索してもらって、リンクに飛べばAmazonの商品ページに飛びます。
大量にあるので、リンク先が間違っている可能性があるので、もし購入される場合は、『試し読み』で目次を確認してください(たまに目次がないものがありますが……)

一応ここでもbitのLisp記事一覧を抜き出してみます。

bitのLisp記事一覧(1970/2000)

1970

1970-12
(LISP) bit Vol.2, No.12 1970: 記号処理言語(2) LISP | 大駒誠一, 中西正和

1971

1971-10
(LISP) bit Vol.3, No.10 1971: コンパイラのうちとそと(10) LISPのばあい─リスト構造をもつデータを扱うプログラミング言語LISP語とそのプロセッサ | 広瀬健, 中田育男, 筧捷彦, 佐久間紘一, 島内剛一

1974

1974-01
(LISP) bit Vol.6, No.1 1974: LISP 入門① マッカーシーの条件式とM式 | 後藤英一
  • 一風変った言語であるLispとはどんな言語なのであろうか?
1974-02
(LISP) bit Vol.6, No.2 1974: LISP 入門② 関数の帰納的定義 | 後藤英一
  • LISPにおける帰納関数の定義について, 例を通して考えてみる
1974-03
(LISP) bit Vol.6, No.3 1974: LISP 入門③ 帰納的定義のFORTRAN処理──プリプロセッサ、FORTRAN── | 後藤英一
  • FORTRANをあたかも帰納的定義に使えるかのように拡張した言語Fとは……
1974-04
(LISP) bit Vol.6, No.4 1974: LISP 入門④ LISPのデータ言語S式 | 後藤英一
  • Lispの演算の対象であるS式と呼ばれる記号列について述べる
1974-05
(LISP) bit Vol.6, No.5 1974: LISP 入門⑤ MS変換, LISPの万能関数 | 後藤英一
  • MS変換, 万能関数と通訳プログラムのの関係を調べてみよう
1974-06
(LISP) bit Vol.6, No.6 1974: LISP 入門⑥ Lispの標準関数 | 後藤英一
  • HLISPとよぶ新版のLispとはどんなものだろうか
1974-07
(LISP) bit Vol.6, No.7 1974: LISP 入門⑦ 連想リストと属性リスト | 後藤英一
  • 連想リストと属性リストについて述べ, Lisp 1.5の通訳プログラムを考える
1974-07
(LISP) bit Vol.6, No.7 1974: LISPプログラムの編集に有効なLISP-EDITORの原理 | 長谷川洋
1974-08
(LISP) bit Vol.6, No.8 1974: LISP 入門⑧ 関数引数の処理, 基本集合演算の高速化 | 後藤英一
  • 大変便利な機能である関数引数などについて説明する
1974-09
(LISP) bit Vol.6, No.9 1974: LISP 入門⑨ HLISP | 後藤英一
  • 単射機能を説明し、基本集合演算の高速化について考えてみる
1974-10
(LISP) bit Vol.6, No.10 1974: LISP 入門⑩ 連想計算機能とHLISP | 後藤英一
  • 例を挙げて連想計算機能などについて考えてみる
1974-11
(LISP) bit Vol.6, No.11 1974: LISP 入門⑪ ガーベッジ・コレクタ廃品回収 | 後藤英一
  • 廃品回収ルーチンとよばれるシステムの構成部分について述べる
1974-12
(LISP) bit Vol.6, No.12 1974: LISP 入門⑫ 仮想的記憶と連想的処理の効用 | 後藤英一
  • 仮想記憶について述べるとともに, 連想計算機能の効果はいかに

1975

1975-01
(LISP) bit Vol.7, No.1 1975: LISP 入門⑬ Backtrack法とLisp | 後藤英一
  • N-Queensの問題を例にとり, Backtrack法について考えてみる
1975-02
(LISP) bit Vol.7, No.2 1975: LISP 入門(完) Lispの入出力プログラム | 後藤英一
  • 入出力プログラムの部分に仕様されるアルゴリズムとその問題点の解説
1975-03
(LISP) bit Vol.7, No.3 1975: LISPコンテスト | 中西正和
1975-10
(LISP) bit Vol.7, No.11 1975: マッカーシは語る─LISPをめぐって | 長谷川洋

1978

1978-06
(LISP) bit Vol.10, No.7 1978: プログラム言語Pascal─レコードの可変部とLispの処理系(6) | 和田英一
1978-07
(LISP) bit Vol.10, No.8 1978: Lisp手習(1) Lisp君登場 | 離数譜
1978-08
(LISP) bit Vol.10, No.9 1978: Lisp手習(2) 一度,もう一度,さらにもう一度,さらにさらにもう一度,… | 離数譜
1978-09
(LISP) bit Vol.10, No.11 1978: Lisp手習(3) 怪力CONS | 離数譜
1978-10
(LISP) bit Vol.10, No.12 1978: Lisp手習(4) 続怪力CONS | 離数譜
1978-11
(LISP) bit Vol.10, No.14 1978: Lisp手習(5) 数遊び | 離数譜
1978-11
(LISP) bit Vol.10, No.14 1978: Lispマシン製作奮戦記(1) | 井田昌之
1978-12
(LISP) bit Vol.10, No.15 1978: Lispコンテスト | 竹内郁雄
1978-12
(LISP) bit Vol.10, No.15 1978: 連載 Lisp手習(6) 章上復有章(マルチの章) | 離数譜
1978-12
(LISP) bit Vol.10, No.15 1978: Lispマシン製作奮戦記(2) | 井田昌之

1979

1979-02
(LISP) bit Vol.11, No.2 1979: Lisp手習(7) あっちもこっちもさあ大変 | 離数譜
1979-03
(LISP) bit Vol.11, No.3 1979: Lisp手習(8) 仲間(集合)と間柄(関係) | 離数譜
1979-04
(LISP) bit Vol.11, No.4 1979: Lisp手習(完) ひとの手を借り,左うちわで | 離数譜
1979-12
(LISP) bit Vol.11, No.12 1979: FLATSマシンの基本構想 | 後藤英一

1980

1980-10
(LISP) bit Vol.12 No.12 1980: ナノピコ教室─出題(LISPとパラドックス演算子) | 後藤滋樹, 斉藤康己
1980-12
(LISP) bit Vol.12 No.14 1980: ナノピコ教室─出題(LISP Poetry) | 黒川利明
1980-12
(LISP) bit Vol.12 No.14 1980: LISP昨今─1980年LISPコンファレンスから | 離数譜
1980-12
(LISP) bit Vol.12 No.14 1980: APPLE LISP | 中西正和

1981

1981-01
(LISP) bit Vol.13 No.1 1981: ナノピコ教室─解答(LISPとパラドックス演算子) | 後藤滋樹, 斉藤康己
1981-03
(LISP) bit Vol.13 No.3 1981: ナノピコ教室─解答(Lisp Poetry) | 黒川利明
1981-03
(LISP) bit Vol.13 No.3 1981: I ♥ COMPUTER─LISPマシンのアーキテクチャ(9) | 坂村健

1982

1982-03
(HYPERLISP) bit Vol.14 No.4 1982: よい子のはいぱーりすぷ | 萩谷昌巳
1982-08
(LISP) bit Vol.14 No.9 1982: LISPとLISPマシン:その現状と展望 | 井田哲雄
1982-11
(LISP) bit Vol.14 No.13 1982: 1982ACMシンポジウム「LISPと関数的プログラミング」に出席して | 井田哲雄

1983

1983-01
(LISP) bit Vol.15 No.1 1983: エディタとテキスト処理(10)─構造エディタ(1)─Lispの場合 | 和田英一
1983-01
(Franz Lisp) bit Vol.15 No.1 1983: UNIXシステム入門(16)─UNIXのFranz Lisp | 石田晴久
1983-06
(LISP) bit Vol.15 No.6 1983: Historical Memorandum:LISP | 高橋肇
1983-10
(LISP) bit Vol.15 No.11 1983: 考える道具としてのLISP入門─考えるための道具としてのコンピュータ(1) | 難波和明, 安西祐一郎
1983-11
(LISP) bit Vol.15 No.12 1983: 考える道具としてのLISP入門─LISPの基本的な使い方(2) | 難波和明, 安西裕一郎
1983-12
(LISP) bit Vol.15 No.13 1983: 連載 考える道具としてのLISP入門─ソフトウェア・ツールズの使い方(3) | 難波和明, 安西祐一郎, 中嶌信弥

1984

1984-01
(LISP) bit Vol.16 No.1 1984: 考える道具としてのLISP入門─LISPの基本関数(4) | 難波和明, 安西祐一郎
1984-02
(LISP) bit Vol.16 No.2 1984: 考える道具としてのLISP入門─ASSOCを使った検索関数(5) | 難波和明, 安西祐一郎, 中嶌信弥
1984-03
(LISP) bit Vol.16 No.3 1984: 考える道具としてのLISP入門─パーソナルユースを目的とした情報検索システム(6) | 難波和明, 安西祐一郎, 中嶌信弥
1984-04
(LISP) bit Vol.16 No.4 1984: 連載 考える道具としてのLISP入門(7)─ソフトウェア・ツールズ(2) | 難波和明, 安西祐一郎, 中嶌信弥
1984-05
(LISP) bit Vol.16 No.5 1984: 連載 考える道具としてLISP入門─PARSER MicroELI(8) | 難波和明, 安西祐一郎
1984-06
(LISP) bit Vol.16 No.7 1984: 考える道具としてのLISP入門─PARSER JUMP(9) | 難波和明, 安西祐一郎, 田村淳
1984-07
(LISP) bit Vol.16 No.8 1984: 連載 考える道具としてのLISP入門─SCRIPT APPLIER MicroSAM(10) | 難波和明, 安西祐一郎
1984-08
(LISP) bit Vol.16 No.9 1984: 考える道具としてのLISP入門─QUESTION ANSWERER MicroQA(11) | 難波和明, 安西祐一郎
1984-09
(LISP) bit Vol.16 No.10 1984: 考える道具としてのLISP入門─文章中の意図の推論(12) | 難波和明, 安西祐一郎
1984-10
(LISP) bit Vol.16 No.11 1984: 考える道具としてのLISP入門(完)─日本語GENERATOR MicroJAG | 難波和明, 安西祐一郎, 田村淳
1984-10
(LISP) bit Vol.16 No.11 1984: LISPコンファレンスに出席して | 井田昌之

1985

1985-01
(LISP) bit Vol.17 No.1 1985: LispマシンSYNAPSE | 寺村信介, 松井祥悟, 加藤良信
1985-03
(LISP) bit Vol.17 No.3 1985: パーソナル数式処理システム─Lisp 68Kの開発とREDUCEの移植 | 山本強, 戸島熙, 村田利文
1985-04
(LISP) bit Vol.17 No.4 1985: Common Lisp 入門(1) | 湯淺太一, 萩谷昌己
1985-05
(LISP) bit Vol.17 No.5 1985: パーソナルLispマシン アーキテクチャとプログラミング環境 | 清水謙多郎
1985-05
(LISP) bit Vol.17 No.5 1985: Common Lisp 入門(2) | 湯淺太一, 萩谷昌己
1985-06
(LISP) bit Vol.17 No.6 1985: 続・パーソナル数式処理システム Lisp コンパイラと REDUCE 実行効率の改善 | 戸島?
1985-06
(LISP) bit Vol.17 No.6 1985: Common Lisp 入門(3) | 湯淺太一, 萩谷昌己
1985-06
(LISP) bit Vol.17 No.6 1985: MS-DOSプログラミング入門 LOGOとLISP(12) | 石田晴久
1985-06
(LISP) bit Vol.17 No.6 1985: マイコン・トピックス GC LISP | 前田英明
1985-08
(LISP) bit Vol.17 No.8 1985: Common Lispのデータ型とその周辺─解説Common Lisp(1) | 井田昌之
1985-09
(LISP) bit Vol.17 No.9 1985: 解説Common Lisp(2)─データ型とその周辺(続) | 井田昌之
1985-10
(LISP) bit Vol.17 No.10 1985: 解説Common Lisp(3)─データ型とその周辺(続々) | 井田昌之
1985-11
(LISP) bit Vol.17 No.11 1985: 解説Common Lisp─クロージャと環境の保存(4) | 井田昌之
1985-11
(LISP) bit Vol.17 No.11 1985: Lispマシンのオブジェクト指向プログラミング | 梅村阿聖
1985-12
(LISP) bit Vol.17 No.12 1985: 第3回Lispコンテストと第1回Prologコンテスト顛末記 | 奥乃博
1985-12
(LISP) bit Vol.17 No.12 1985: 解説Common Lisp(完) Common Lispの特徴的な構造 | 井田昌之

1986

1986-09
(LISP) bit Vol.18 No.10 1986: Common Lispアラカルト(1)─いったい今,何が起こっているのか? | 井田昌之
1986-09
(LISP) bit Vol.18 No.10 1986: サンマルコLISP探検隊 | 益田誠也, 白井英俊
1986-09
(LISP) bit Vol.18 No.10 1986: BASICで書いたLISP(1) | 猪飼秀隆
1986-10
(LISP) bit Vol.18 No.11 1986: BASICで書いたLISP(2) | 猪飼秀隆
1986-10
(LISP) bit Vol.18 No.11 1986: Common Lispアラカルト(2)クロージャ | 梅村恭司
1986-11
(LISP) bit Vol.18 No.12 1986: Common Lispアラカルト(3)Eulisp | 湯淺太一
1986-12
(LISP) bit Vol.18 No.13 1986: Common Lispアラカルト(4)VAX LISP | 川合進

1987

1987-01
(LISP) bit Vol.19 No.1 1987: Common Lispアラカルト(5)─CommonLoops | 加藤英樹
1987-02
(LISP) bit Vol.19 No.2 1987: Common Lisp アラカルト(6)─Scheme | 幕足譲
1987-03
(LISP) bit Vol.19 No.4 1987: Common Lispアラカルト(7)─ANSI X3J13 | 井田昌之
1987-04
(LISP) bit Vol.19 No.4 1987: Common Lispアラカルト(8) Symbolics Common Lisp | 南出仁志
1987-05
(LISP) bit Vol.19 No.5 1987: Common Lispアラカルト─日本語化(9) | 元吉文男
1987-06
(LISP) bit Vol.19 No.7 1987: Common Lispアラカルト(10)パロアルト・ミーティング | 井田昌之
1987-06
(LISP) bit Vol.19 No.7 1987: 7bits インスタント・コンパイラ | Themsky
1987-07
(LISP) bit Vol.19 No.8 1987: CLOS:Common Lisp Object System | 湯淺太一
1987-07
(LISP) bit Vol.19 No.8 1987: Common Lispアラカルト(11)オブジェクト指向の将来 | 佐治信之
1987-09
(LISP) bit Vol.19 No.10 1987: Common Lispアラカルト(12)─Gold Hillよりのメッセージ①─Golden Common Lispプログラミング環境 | John Teeter
1987-10
(LISP) bit Vol.19 No.11 1987: Common Lispアラカルト(13) Gold Hillよりのメッセージ(2)─GCLISPの他言語インタフェース | John Teeter
1987-11
(LISP) bit Vol.19 No.12 1987: Common Lisp アラカルト(14) 対談:Lisp マシンとパソコンの狭間で | John Teeter, 井田昌之
1987-11
(LISP) bit Vol.19 No.12 1987: 自然言語処理および画像処理とLispマシン | 中村順一
1987-12
(LISP) bit Vol.19 No.14 1987: Common Lispアラカルト─ケンブリッジ・ミーティング(完) | 塩田英二

1988

1988-01
(TAO) bit Vol.20 No.1 1988: マルチパラダイム言語TAO(1)LispマシンELIS | 竹内郁雄
1988-02
(TAO) bit Vol.20 No.2 1988: マルチパラダイム言語TAO(2)TAOのデータ型 | 竹内郁雄
1988-03
(TAO) bit Vol.20 No.3 1988: マルチパラダイム言語TAO(3)インタプリタ,変数,ループ | 竹内郁雄
1988-04
(TAO) bit Vol.20 No.4 1988: マルチパラダイム言語TAO(4)─代入,閃数,catch | 竹内郁雄
1988-05
(TAO) bit Vol.20 No.5 1988: マルチパラダイム言語TAO(5) オブジェクト指向(1) | 竹内郁雄
1988-06
(TAO) bit Vol.20 No.6 1988: マルチパラダイム言語TAO(6)─オブジェクト指向(2) | 竹内郁雄
1988-07
(TAO) bit Vol.20 No.7 1988: マルチパラダイム言語TAO(7)─論理型パラダイム(1) | 竹内郁雄
1988-08
(TAO) bit Vol.20 No.8 1988: マルチパラダイム言語TAO(8) 論理型パラダイム(2) | 竹内郁雄
1988-09
(TAO) bit Vol.20 No.9 1988: マルチパラダイム言語TAO オブシェクト指向論理型プログラミング(9) | 竹内郁雄
1988-10
(TAO) bit Vol.20 No.10 1988: マルチパラダイム言語TAO(10)─並行プログラミング(1) | 竹内郁雄
1988-11
(TAO) bit Vol.20 No.11 1988: マルチパラダイム言語TAO(11)─並行プログラミング(2) | 竹内郁雄
1988-12
(TAO) bit Vol.20 No.12 1988: マルチパラダイム言語TAO(完)─Common Lispと番地型計算 | 竹内郁雄

1989

1989-02
(LISP) bit Vol.21 No.2 1989: AAAI CLOSワークショップ | 井田昌之
1989-05
(LISP) bit Vol.21 No.6 1989: Common Lisp最前線─マクロがもたらすもの(1) | 井田昌之
1989-06
(LISP) bit Vol.21 No.7 1989: Common Lisp最前線─CLUE─Common Lispユーザ・インタフェース環境(2) | 川辺治之
1989-07
(LISP) bit Vol.21 No.8 1989: Common Lisp最前線─Lisp対C(3) | 湯浦克彦
1989-08
(LISP) bit Vol.21 No.9 1989: Common Lisp最前線─Common Windows on X(4) | 井田昌之, 田中啓介
1989-09
(LISP) bit Vol.21 No.10 1989: Common Lisp最前線─漢字化の現状について(5) | 元吉文男
1989-10
(LISP) bit Vol.21 No.12 1989: Common Lisp最前線─日本語Common Windowsについて(6) | 古坂孝史
1989-11
(LISP) bit Vol.21 No.13 1989: Common Lisp最前線(完)─PCL abstract LAP | 増田佳弘

1990

1990-02
(Common Lisp, CLOS) bit Vol.22 No.2 1990: 対談:オブジェクト指向新時代にのぞんで | グレゴー・キザレス, 井田昌之
1990-07
(LISP) bit Vol.22 No.7 1990: 単語帖─RFC,kerberes,3-LISP、項書換え系 | p66~66
1990-07
(LISP) bit Vol.22 No.7 1990: Europal'90に参加して─The First European Conference on the PracLical Application of Lisp | 田中啓介

1995

1995-05
(LISP) bit Vol.27 No.5 1995: 機能拡張言語としてのGNU Emacs Lisp─リチャード・ストールマン | 井田昌之, 土井巧

1996

1996-04
(Scheme) bit Vol.28 No.4 1996: Scheme過去・現在・未来(前編) | Guy L.Steele Jr., 井田昌之
1996-05
(Scheme) bit Vol.28 No.5 1996: Scheme過去・現在・未来─後編 | Guy L.Steele Jr, 井田昌之

1997

1997-09
(LISP) bit Vol.29 No.9 1997: Emacs Lispで作る | 淵野

1998

1998-03
(LISP) bit Vol.30 No.3 1998: 進化的プログラミング言語Common Lisp(前編)ロボカップでの経験を交えて | 苫米地
1998-04
(LISP) bit Vol.30 No.4 1998: 進化的プログラミング言語Common Lisp(後編)─その動的オブジェクト指向性とWebへのインパクト | 苫米地

1999

1999-02
(LISP) bit Vol.31 No.2 1999: JIS | ISO標準ISLISPによるLISP教育
1999-04
(LISP) bit Vol.31 No.4 1999: Topics Lisp生誕40周年記念ユーザコンファレンス | 湯淺

2000

2000-05
(LISP) bit Vol.32 No.5 2000: やっぱり,Lispだね | 竹内
2000-09
(LISP) bit Vol.32 No.9 2000: JLUGM─日本Lispユーザ会議(1)全体報告 | 湯淺
2000-10
(LISP) bit Vol.32 No.10 2000: JLUGM─日本Lispユーザ会議(2)Lisp応用事例:自動車衝突試験データベースシステムの構築 | 黒田
2000-11
(LISP) bit Vol.32 No.11 2000: JLUGM─日本Lispユーザ会議(3)次世代Web技術としての動的サーバ技術─マルチスレッドLispによる可能性 | 苫米地


HTML generated by 3bmd in LispWorks 8.0.0

setqはprogの中だけで使うというスタイルの提案

Posted 2021-11-30 16:05:39 GMT

Lisp一人 Advent Calendar 2021 1日目の記事です。

ここ数年ニッチなテーマでアドベントカレンダーを開催したりしなかったりしています。 今年は何も準備していなかったので、どうせ一人で開催だし見送ろうかと思いましたが、普段からLispブログのネタだけは50位のストックがあるので、この機会に成仏させることにしました。
ちなみに割とどうでも良いようなネタしかありません。

setqprogの中だけで使うというスタイルの提案

近年、純粋関数型言語の擡頭で、世間はやれデータはイミュータブルが良いやらなんやらと喧しいですが、関数型プログラミングの先駆けたるLISPは極初期からこのあたりのプログラミングスタイルの使い分けをしていました。

具体的にいうと、当時のFortran等の繰り返しや代入スタイルでコードを書けるようにするためのprog形式が用意されていて、go(goto)、return(飛び出し)、set/setq(代入)は、progの中でのみ使えるというものでした。
また、基本的に式は値を返すものなので、値を返さない式が続く場合も基本的にprogの中で書いていました(prognの前身のprog2は存在しましたが)。 progが導入された意図ですが、はやはり1960年代初頭の当時のコンピューター上での効率を考えてのことだったようです。

この辺りの事情を今風に表現するなら、純粋関数型プログラミングの内部に手続き型プログラミングのためのDSLを標準装備していたという感じでしょうか。

その後、1968年あたりのPDP-6 LISP(MACLISP)で、さらに効率を追求されることになり、全面的に浅い束縛が導入された結果、progの中での限定利用だったsetqは大域的に利用できるようにもなり今に至ります。 ちなみにそれまで大域変数の宣言には、cset/csetqという、Common Lispでいうdefconstantのようなものがありましたが、setqに置き換えられてしまいました。

そして、さらにCommon Lispになってprogはより抽象度の高い繰り返し構文等に置き換えられ、前時代的なものになりました。

setqprogの中だけで使うというスタイル、というのは、この前時代的なprogを使うことによって、代入という行為をしているコードをさらに古臭く見えるようにする、というのが狙いです。

実際に書くとどういう風になるか

基本的にletの中でsetqsetfをしている場合にprogで置き換えれば良いのですが、変数宣言だけして、初期化はボディ内でsetqする、という風に書くとさらに古臭くできます。

(let* ((x ...)
       (y ...))
  (setq x ...)
  (setq y ...)
  ans)

(prog (x y)
      (setq x ...)
      (setq y ...)
      (return ans))

ちなみに、progは変数宣言節と同じ深さでまっすぐにインデントを揃えるのが古くからの習わしです(1970年あたりの古いコードを読んでみましょう)


HTML generated by 3bmd in LispWorks 7.0.0

アクターモデルとPLASMAとSmalltalk-72の関係を雑に探る

Posted 2021-11-28 20:07:35 GMT

Smalltalk-72の解説動画を観ていて、PLASMAの論文で解説されていた謎のSmalltalkは、Smalltalk-72のことだったんだなあ、と合点がいったのですが、そういえば、アクターモデルとPLASMAとメッセージ送信とSmalltalk-72の関係って結局どういうことになっていたのか気になったので調べてみました。

調べてみたといっても、主にアクターモデル側のPLASMAの論文に書いてあることを確認しただけなので雑です。

PLASMA陣営から俯瞰したSmalltalkとの関係については、「A PLASMA PRIMER」に“HISTORICAL PERSPECTIVE - Relationship between PLASMA and SMALLTALK”として約5ページに渡っての解説が詳しいかと思いますが、ざっくりまとめてしまうと

  • アクターモデルは計算モデル
  • PLASMAはアクターモデルの意味論をベースに組み立てた言語であり、言語そのものより、アクターモデルの実証がプロジェクトの主題
  • アクターモデルは下記の諸々をアクターとして一般化してみせたモデル

    • Smalltalkのメッセージ送信とintentional definitions of data structures(所謂オブジェクト?)
    • それまでのPlannerの研究
    • 関数型データ構造(Church、Landin、Evans、Reynolds等)
    • それまでのコルーチン等の制御構造の一般化の研究
    • シーモア・パパートのLOGOにおける「Little man」計算メタファー
    • Dennis、Plummer、Lampsonらのケイパビリティベースのマシン間の通信機構
  • Smalltalkは、“children of all ages”のための言語であり、PLASMAとはゴールが全く異なる。

ということみたいです。

とりわけ、1972年11月のMITでのアラン・ケイのセミナーでの“intentional definitions of data structures”とメッセージ送信という概念の影響は大きかった故に詳しく解説があるのだと思いますが、ヒューイットはそれまでの自身の研究(Planner等)からデータの側にゴール(手続き)を埋め込むアイデアであると即座に理解したようです。
この背景としては、当時のAI研究周辺では、1960年代あたりから、知識表現について宣言的(=データ)か、手続き的な表現か、の論争があったのですが、ミンスキーのフレーム理論もオブジェクト指向も1970年代は、これらの中間的アプローチと考えられたりしたようです。

さて、メッセージ送信のアイデアはともかく、Smalltalk-72の実装については、メッセージ送信が、トークンストリームをベースとしているため、ヒューイットは、Conniverの“possibility lists”と同じく大域的な副作用があることを問題とし、アクターモデルでは大域的な副作用は排除することで並列処理が可能なように一般化したようです。この辺りは急に実装ベースの話をしているなという印象。

また、関数でデータを表す(オブジェクト)ことについても、それまで検討はしたことがあったものの、効率が悪すぎて使い物にならないと誤解していたのを払拭することにもなったようです。
上述のリストにあるように、以前から関数でデータを表現するというのは、ReynoldsのGEDANKENのような先達の研究がありますが、メッセージ送信で、関数呼び出し、コルーチン、継続等を表現することも可能ということと合せると、データも手続きもアクターというプリミティブで全部表現できるということになります。

メッセージ送信をプリミティブにしても良さそうですが、メッセージ自体もアクターということなので万物の計算プリミティブとしてアクターを据えることに成功した、ということなのでしょう(多分)

アラン・ケイのオブジェクト指向モデルと初期アクターモデルの対比

Smalltalk-72と初期のアクターモデルとの対比となると、対象のレベルがずれてしまうので、レベルを合せて比較してみました。

目的

アクター
アクターという概念で計算をモデル化する
OO
children of all agesのためのDynabookのためのプログラミングモデル

構成される総体

アクター
アクター
OO
ネットワークで接続されたコンピューター的なもの(身体と細胞)

最小の要素

アクター
アクター
OO
コンピューター(細胞)とメッセージ

モデルの(参照)実装

アクター
PLASMA
OO
Smalltalk-72

まとめ

The Early History Of Smalltalkによると、アラン・ケイは最小の構成単位として関数やデータに分ける必然性はあるだろうかと問うて、多数の自立するネットワーク化された計算細胞のようなものを考えたようですが、ヒューイットは関数やデータを更に分解して、結局似たようなモデルを作ったのは面白いなと思いました。

また、この文献によると、LISPが関数と特殊形式というプリミティブに分けるのではなく、全部FEXPRという特殊な関数にしたらどういうことになるかを考えたのが、Smalltalkを考える材料になったとありますが、全面的にFEXPRで構成するということは、関数が個別に渡された引数をevalするということです。FEXPR→オブジェクト、引数→メッセージということかと思いますが、上述のPLASMAの文献にも、その辺りに相当することが書いてあり、Smalltalk-72では、トークンのストリームで実現しているところをPLASMAでは拡張性がある記述が可能、との説明があります。

[eval ≡
  (=> [=the-expression using =the-environment]
      (the-expression <= (eval: the-environment)))]

この辺りも交流があったのか、似たようなことを考えていて似たような結論になったのかは分かりませんが面白いと思いました。

ちなみに、Schemeの学習教材などに、なんでもλというプリミティブに還元してみせるという例が良く出てくるのですが、なんでもアクターというプリミティブで表現するという路線を継承したのかなと思わなくもありません。
(クロージャーでOOPみたいな話は何周もして元の話に戻った気がしないでもない)

1970年代から、並行計算モデルとして耳にするようになった最近まで、還元主義としてのアクターモデルの方は、あまり一般的には受け入れられているようには見えないのですが、λの方はそこそこ一般的になったことを考えると不思議です。
関数より細かく分解するというのは受け入れ難いことだったのでしょうか。


HTML generated by 3bmd in LispWorks 7.0.0

goやreturn-fromを関数の外から与える

Posted 2021-10-28 17:40:05 GMT

コード整理で関数の分割や統合を行なっている際に、return-from等で脱出する場所を上手く小分けにできなかったり、まとめられなかったりする局面がたまにありますが、blockのタグやtagbodyのラベルをクロージャーにして渡してしまえば簡単だということに気付きました。

例えば、このような一つの関数を

(defun foo (int)
  (when (oddp int) (return-from foo (values int 'odd)))
  (print (+ 1 int))
  (print "fin"))

(foo 99) → 99 odd

(foo 98) ▻ ▻ 99 ▻ "fin" → "fin"

二つの関数に分解できます。

(defun bar (int xit)
  (when (oddp int) (funcall xit int))
  (print (+ 1 int)))

(defun foo (int) (bar int (lambda (int) (return-from foo (values int 'odd)))) (print "fin"))

(foo 99) → 99 odd

(foo 98) ▻ ▻ 99 ▻ "fin" → "fin"

tagbodyのラベルも同様です。

(defun foo (int &aux ans)
  (tagbody 
    (bar int (lambda (int) 
               (setq ans int)
               (go X)))
    (print "fin")
  X (return-from foo ans)))

まとめ

リファクタリング作業等ではたまに使えることもあるかもしれません。
ちなみに、tagbodyのラベルもblockのブロック名もレキシカル変数とは違って有限エクステントなので、式の外へは持ち出せませんので注意しましょう。


HTML generated by 3bmd in LispWorks 7.0.0

データの検索に組み込みPrologを使ってみる(4): RDBと組み合わせる

Posted 2021-10-14 03:53:50 GMT

Common Prolog + Common SQL 篇

前回は、Allegro Prolog + AllegroCache の組み合わせを試しましたが、今回は、同じく商用の処理系であるLispWorksのCommon Prolog + Common SQLの組み合わせで試してみたいと思います。

Common Prologは、LispWorksの組み込みProlog、Common SQLは、各種SQLとの接続パッケージでSQLのテーブルとオブジェクトとのマッピングが可能な所謂ORM機能もあります。
これらは元々KnowledgeWorksとして1990年からあるようですが、Common SQLは1992年にDataWorksの後継として開発されたようなので若干新しいようです(といっても古い)

パッケージ定義/ユーティリティ等は前回のものを引き続き利用しています。

(require "sql")
(require "sqlite")
(require "kw")

(defpackage covid19.mhlw.go.jp (:use cl fare-csv sql kw))

(in-package covid19.mhlw.go.jp)

Allegro CLのAllegroCacheに対応するものとしてCommon SQLとSQLite3を試してみます。
Common SQLではSQLをLisp的に記述することが可能ですが、そのためにはリーダーマクロを有効する必要があります。
便利なようなそうでもないような。
SQLのクエリを文字列で与えるqueryという仕組みもありSQLに慣れた人はそちらの方が便利かもしれません。

(locally-enable-sql-reader-syntax)

;; SQLite3のDBへ接続(DBファイルが作成される)
(connect "covid19.sqlite3")

;; テーブル作成 (create-table [newly_confirmed_cases_daily] '(([date] text) ([prefecture] text) ([newly_confirmed_cases] integer)))

;;query版 (query "create table newly_confirmed_cases_daily(date text, prefecture text, newly_confirmed_cases integer);")

;; データベースへ登録 (with-transaction (dolist (line (subseq (cdr *newly_confirmed_cases_daily.csv*) 0 nil)) (destructuring-bind ($date $prefecture $newly-confirmed-cases) line (insert-records :into [newly_confirmed_cases_daily] :attributes '([date] [prefecture] [newly_confirmed_cases]) :values (list (parse-date $date) $prefecture $newly-confirmed-cases)))))

;;query版 (with-transaction (dolist (line (subseq (cdr *newly_confirmed_cases_daily.csv*) 0 nil)) (destructuring-bind ($date $prefecture $newly-confirmed-cases) line (query (format nil "insert into newly_confirmed_cases_daily(date, prefecture, newly_confirmed_cases) values ('~A', '~A', ~A);~%" (parse-date $date) $prefecture $newly-confirmed-cases)))))

  • SQLでクエリ

;;;愛知の2021年9月の合計
(select [sum [newly_confirmed_cases]] :from [newly_confirmed_cases_daily]
        :where [and [= [prefecture] "Aichi"]
                    [between [date] "2021-09-01" "2021-09-30"]]
        :flatp T)(21209) 
  ("SUM(NEWLY_CONFIRMED_CASES)") 

;;query版 (query "select sum(newly_confirmed_cases) from newly_confirmed_cases_daily where prefecture='Aichi' and date between '2021-09-01' and '2021-09-30'" :flatp T)

;;;都道府県のリストを取得する (select [distinct [prefecture]] :from [newly_confirmed_cases_daily] :where [<> [prefecture] "ALL"])

;;query版 (query "select distinct prefecture from newly_confirmed_cases_daily where prefecture != 'ALL'" :flatp T)

;;;都道府県ごとの合計 (select [prefecture] [sum [newly_confirmed_cases]] :from [newly_confirmed_cases_daily] :where [<> [prefecture] "ALL"] :group-by [prefecture] :limit 2)(("Shizuoka" 26308) ("Shiga" 12388))

;;query版 (query " select prefecture, sum(newly_confirmed_cases) from newly_confirmed_cases_daily where prefecture != 'ALL' group by prefecture limit 2")

Common SQLのORM機能とCommon Prologの組み合わせ

さて課題自体は、Prologを使わずにSQLで解決してしまいましたが、Prolog連携も試してみます。
SQLのテーブルとのマッピングにはdef-view-classという、standard-db-classをメタクラスとしたdefclassの派生を利用します。

SQL=Objectと、Prologとの連携ですが、KnowledgeWorksではOPS5互換の前向き推論とProlog互換の後ろ向き推論をワーキングメモリ上のオブジェクトと連携させる仕組みがあり、オブジェクトが生成されると自動でワーキングメモリに登録されます。
自動登録のためにはstandard-kb-objectのサブクラスにする必要があるためクラス定義でmixinしておきます。

ワーキングメモリに処理対象を全件載せるためには、SQLでクエリしオブジェクトを生成→ワーキングメモリに載る、の手順を踏みます。

(def-view-class newly_confirmed_cases_daily (standard-db-object standard-kb-object)
  ((id :type integer :db-kind :key :column rowid) ;sqlite3では自動でrowidというのができる
   (date :type T)
   (prefecture :type T)
   (newly_confirmed_cases :type integer))
  (:base-table |newly_confirmed_cases_daily|))

;; ワーキングメモリに処理対象を全件載せる (select 'newly_confirmed_cases_daily)

;;愛知の2021年9月の合計 (let ((query '(and (newly_confirmed_cases_daily ? date ?date prefecture "Aichi" newly_confirmed_cases ?cases) ((search "2021-09-" ?date) 0)))) (reduce #'+ (findall '?cases query))) → 21255

;;都道府県ごとの合計 (let ((tab (make-hash-table :test #'equal))) (findall nil `(and (newly_confirmed_cases_daily ?x prefecture ?pref newly_confirmed_cases ?cases) ((incf (gethash ?pref ,tab 0) ?cases) ?))) (loop :for pref :being :the :hash-keys :of tab :using (:hash-value cases) :repeat 2 :collect (list pref cases)))(("Shizuoka" 26308) ("Shiga" 12388))

まとめ

KnowledgeWorksでは、未だに開発版扱いのAllegro Prologよりは、オブジェクトシステムとPrologの融合がより進んでいます。
ワーキングメモリに載せて処理するというのがちょっと特殊ですがPrologだけでなく、前向き推論部とも連携できますし多分強力なのでしょう。

知識ベース+前向き推論+後ろ向き推論をRDB+OPS5+Prologで実現したようなシステムは、1980年代後半のエキスパートシステムの割と標準的な構成だったようです。
1990年に登場したKnowledgeWorksもそういう流れの一つなのかなと思いますが、現在でも、AllegroGraphのようなグラフDB(知識ベース)の流れに脈々と受け継がれているかと思います。


HTML generated by 3bmd in LispWorks 7.0.0

データの検索に組み込みPrologを使ってみる(3): オブジェクトデータベースと組み合わせる

Posted 2021-10-12 03:43:11 GMT

Allegro Prolog + AllegroCache 篇

PAIPrologで挑戦したところデータの登録に難があったので、その辺りの問題はクリアされていそうな、Allegro Prolog + AllegroCache で試してみたいと思います。

パッケージ定義/ユーティリティ等は前回のものを引き続き利用しています。

(require :acache "acache-3.0.8.fasl") ;環境ごとにバージョンが異なる
(require "pcache")
(require "prolog")

(defpackage covid19.mhlw.go.jp (:use cl fare-csv prolog db.allegrocache))

;;OODBのためのユーティリティ (defmacro with-file-database ((name &key (if-exists nil if-exists-p) (if-does-not-exist nil if-does-not-exist-p) read-only) &body body) `(let ((*allegrocache* nil)) (unwind-protect (multiple-value-prog1 (progn (open-file-database ,name ,@(and if-exists-p `(:if-exists ,if-exists)) ,@(and if-does-not-exist-p `(:if-does-not-exist ,if-does-not-exist))) ,@body) (unless ,read-only (commit))) (when *allegrocache* (close-database :db *allegrocache*)))))

;;節となるオブジェクト定義 (defclass covid19-newly-confirmed-cases-daily () (date prefecture cases) (:metaclass persistent-class))

;;データを登録 (with-file-database ("/tmp/covid19.db" :if-does-not-exist :create :if-exists :supersede) (dolist (row (cdr *newly_confirmed_cases_daily.csv*)) (let ((obj (make-instance 'covid19-newly-confirmed-cases-daily))) (with-slots (date prefecture cases) obj (setf (values date prefecture cases) (values (covid19-date row) (covid19-prefecture row) (covid19-cases row)))))))

;;愛知の2021年9月の合計 (with-file-database ("/tmp/covid19.db") (let ((sum 0)) (prolog (db covid19-newly-confirmed-cases-daily ?obj date (2021 9 ?) prefecture "Aichi" cases ?cases ) (lisp (incf sum ?cases))) sum)) → 21255

;;都道府県ごとの合計 (with-file-database ("/tmp/covid19.db") (let ((tab (make-hash-table :test #'equal))) (prolog (db covid19-newly-confirmed-cases-daily ?obj) (is ?pref (slot-value ?obj 'prefecture)) (is ?cases (slot-value ?obj 'cases)) (lisp (incf (gethash ?pref tab 0) ?cases))) (loop :for pref :being :the :hash-keys :of tab :using (:hash-value cases) :repeat 2 :collect (list pref cases))))(("Shizuoka" 26308) ("Shiga" 12388))

まとめ

Allegro PrologはPAIPrologから派生しただけに似た感じではありますが、AllegroCacheと連携することによってオブジェクトのクエリが可能になります。
今回の場合、永続化機能は必要ないのですが、Allegro Prologのdb述語を利用するにはpersistent-classと連携するほかないようです。
別途インスタンスプールにインスタンスを登録するメタクラスとdb述語のようなパタンマッチ述語を自作すれば、AllegroCacheを迂回することも可能かとは思います。


HTML generated by 3bmd in LispWorks 7.0.0

データの検索に組み込みPrologを使ってみる(2)

Posted 2021-10-12 02:09:57 GMT

データの検索に組み込みPrologを使ってみる試みの続きですが、CSVファイルを集計する記事を読みこちらお題を真似てみることにしました。

まずは手続き的に書いてみる

とりあえず比較のため普通に書いてみます。

(cl:in-package "CL-USER")

(ql:quickload '(drakma fare-csv babel srfi-2))

(defpackage covid19.mhlw.go.jp (:use cl fare-csv drakma babel srfi-2))

(cl:in-package covid19.mhlw.go.jp)

(defun read-csv/utf-8 (url) (and-let* ((csv-bin (http-request url :force-binary T)) (csv (octets-to-string csv-bin :encoding :utf-8))) (with-input-from-string (in csv) (read-csv-stream in))))

(defvar *newly_confirmed_cases_daily.csv* (read-csv/utf-8 "https://covid19.mhlw.go.jp/public/opendata/newly_confirmed_cases_daily.csv"))

;;ヘッダを確認 (car *newly_confirmed_cases_daily.csv*)("Date" "Prefecture" "Newly confirmed cases")

;;ヘッダ情報からリストのアクセサを作成してみる (defstruct (covid19 (:type list)) date prefecture cases)

;;元データの型変換: 数値文字列→数値 (dolist (row (cdr *newly_confirmed_cases_daily.csv*)) (setf (covid19-cases row) (parse-integer (covid19-cases row))))

(defun group-by (accessor list) (let ((tab (make-hash-table :test #'equal))) (dolist (r (reverse list)) (push r (gethash (funcall accessor r) tab '()))) tab))

(defun sum (accessor list) (reduce #'+ list :key accessor))

;;愛知の2021年9月の合計 (loop :for (date prefecture newly-confirmed-cases) :in (cdr *newly_confirmed_cases_daily.csv*) :when (and (equal "Aichi" prefecture) (search "2021/9/" date)) :sum newly-confirmed-cases) → 21255

;;都道府県ごとの合計 (loop :for v :being :the :hash-values :of (group-by #'covid19-prefecture (cdr *newly_confirmed_cases_daily.csv*)) :repeat 2 :for pref := (covid19-prefecture (car v)) :unless (equal pref "ALL") ;ALLを除外したい場合 :collect (list pref (sum #'covid19-cases v)))(("Shizuoka" 26308) ("Shiga" 12388))

PAIProlog 篇

組み込みPrologであれば色々と複雑なクエリを簡単に記述できますが、今回のデータ量約30,000をそのままPAIPrologの述語として登録して検索してみると非常に遅いため、別途方策を練る必要があるようです。
また、LispWorksのCommon PrologやAllegro CLのAllegro Prologに比べるとProlog側のユーティリティが少ないため殆どプリミティブで書くことになります。
とはいえ、今回の集計に必要なSQLでいうところのgroup byのようなユーティリティはCommon PrologでもAllegro Prologでも別途用意する必要はありますが……。

(ql:quickload 'paiprolog)

(use-package 'paiprolog)

(defun parse-date (date) (ppcre:register-groups-bind ((#'parse-integer y) (#'parse-integer m) (#'parse-integer d)) ("(\\d+)/(\\d+)/(\\d+)" date) (list y m d)))

;;元データの変換: 日付をリストへ: "2021/1/1" → (2021 1 1) (dolist (row (cdr *newly_confirmed_cases_daily.csv*)) (setf (covid19-date row) (parse-date (covid19-date row))))

;;オブジェクトをPrologの項として登録するためのユーティリティ (defun add-object-clause (name obj &key asserta) (let ((pred name)) (assert (and (symbolp pred) (not (paiprolog::variable-p pred)))) (pushnew pred paiprolog::*db-predicates*) (pushnew pred paiprolog::*uncompiled*) (setf (get pred 'paiprolog::clauses) (if asserta (nconc (list (list (list name obj))) (paiprolog::get-clauses pred)) (nconc (paiprolog::get-clauses pred) (list (list (list name obj)))))) pred))

;;節となるオブジェクト定義 (defclass covid19-newly-confirmed-cases-daily () (date prefecture cases))

;;データを登録 (dolist (row (cdr *newly_confirmed_cases_daily.csv*)) (let ((obj (make-instance 'covid19-newly-confirmed-cases-daily))) (with-slots (date prefecture cases) obj (setf (values date prefecture cases) (values (covid19-date row) (covid19-prefecture row) (covid19-cases row)))) (add-object-clause 'covid19-newly-confirmed-cases-daily obj)))

(length (paiprolog::get-clauses 'covid19-newly-confirmed-cases-daily)) → 29952

;;愛知の2021年9月の合計 (let ((sum 0)) (prolog (covid19-newly-confirmed-cases-daily ?obj) (is ?pref (slot-value ?obj 'prefecture)) (is ?date (slot-value ?obj 'date)) (is ?cases (slot-value ?obj 'cases)) (= "Aichi" ?pref) (= (2021 9 ?) ?date) (lisp (incf sum ?cases))) sum) → 21255 ;;初回問い合わせは5分位かかるかも…… ;;都道府県ごとの合計 (let ((tab (make-hash-table :test #'equal))) (prolog (covid19-newly-confirmed-cases-daily ?obj) (is ?pref (slot-value ?obj 'prefecture)) (is ?cases (slot-value ?obj 'cases)) (lisp (incf (gethash ?pref tab 0) ?cases))) (loop :for pref :being :the :hash-keys :of tab :using (:hash-value cases) :repeat 2 :collect (list pref cases)))(("Shizuoka" 26308) ("Shiga" 12388))

まとめ

今回のお題のクエリは、SQLでいうとselect prefecture,sum(cases) from table group by prefectureのようなところですが、どうもPAIPrologの場合は、データ量は少ないけれどクエリは複雑な場合に向いていそうです。


HTML generated by 3bmd in LispWorks 7.0.0

Rubyオブジェクトの未来をつくる「シェイプ」をCommon Lispで実装してみた

Posted 2021-09-28 15:04:10 GMT

こちらの記事を読んでCommon Lispに既に似たような機構があるなと思ったので、このshapeというものをCommon Lispで実装してみることにしました。

shapeの動作

まずRuby(TruffleRuby)のshapeは下記のような動作とのことです。

# read
index = obj.shape[:name]
obj[index]

# write index = obj.shape[:name] obj[index] = value

オブジェクトのスロット名からスロットのインデックスを算出し、オブジェクトの内部配列をインデックスでアクセスするから速いということのようです。
オブジェクトからスロットのインデックスを算出するということなので、Common Lisp(AMOP)で表現すると、大体下記のようなところでしょうか

(defgeneric shape (obj slot-name))

(defmethod shape ((obj standard-object) slot-name) (slot-definition-location (find slot-name (class-slots (class-of obj)) :key #'slot-definition-name)))

(defclass foo ()
  (a b c))

(let ((obj (make-instance 'foo))) (setf (standard-instance-access obj (shape obj 'a)) 42) (standard-instance-access obj (shape obj 'a))) → 42

高速化してみる

記事中にRubyのクラスがfrozenの場合は高速化できるようなことが書いてあったので、Common Lispでも最適化してみましょう。

frozenに該当する機構はCommon Lispには存在しないので、適当にフラグを付けるだけにしておきます。
ちなみに、Common Lispでも一応その類の最適化を模索している人達もいます。大体はDylanのsealingをお手本にしているようです。

とりあえず、class-frozen-pは下記のようにしてみます。

(defgeneric class-frozen-p (class))
(defmethod class-frozen-p ((class cl:standard-class))
  (get (class-name class) 'frozenp))

(defgeneric (setf class-frozen-p) (boolean class)) (defmethod (setf class-frozen-p) (boolean (class cl:standard-class)) (setf (get (class-name class) 'frozenp) boolean))

コンパイラマクロを付けてみる

次に、class-frozen-p が成立する場合、インデックスの算出をコンパイル時に行うことにしてみます。
コンパイル時にクラス情報を取得するのが難しいので、今回は手抜きでstandard-objectのインスタンスもしくは、(the ...)で型宣言された場合にコンパイラマクロを展開するようにしてみます。

(define-compiler-macro shape (&whole whole obj slot-name)
  (flet ((compute-slot-location (class)
           (slot-definition-location
            (find (the symbol (eval slot-name)) (class-slots class) :key #'slot-definition-name))))
    (let ((class (typecase obj
                   ((cons (eql the) *)
                    (find-class (elt obj 1)))
                   (standard-object
                    (class-of obj))
                   (T :unknown))))
      (typecase class
        (class (if (class-frozen-p class)
                   (let* ((loc (compute-slot-location class)))
                     (check-type loc integer)
                     loc)
                   whole))
        (T whole)))))

試してみる

(setf (class-frozen-p (find-class 'foo)) T)

(defun set-foo-a-fast (obj value) (declare (optimize (speed 3) (safety 0) (debug 0))) (setf (standard-instance-access obj (shape (the foo obj) 'a)) value) (standard-instance-access obj (shape (the foo obj) 'a)))

上記のset-foo-a-fastは、SBCLで最適化されるとdisassembleの結果は下記のようになり、ほぼ内部の配列に添字でアクセスしているだけです。

; disassembly for set-foo-a-fast
; Size: 22 bytes. Origin: #x53823BA6
; A6:       488B4205         mov RAX, [RDX+5]                 ; no-arg-parsing entry point
; AA:       48897801         mov [RAX+1], RDI
; AE:       488B4205         mov RAX, [RDX+5]
; B2:       488B5001         mov RDX, [RAX+1]
; B6:       488BE5           mov RSP, RBP
; B9:       F8               clc
; BA:       5D               pop RBP
; BB:       C3               ret

最適化を発動させない場合、

(setf (class-frozen-p (find-class 'foo)) nil)

(defun set-foo-a-slow (obj value) (declare (optimize (speed 3) (safety 0) (debug 0))) (setf (standard-instance-access obj (shape obj 'a)) value) (standard-instance-access obj (shape obj 'a)))

下記のように実行時にスロット名を引いてアクセスしています。

; disassembly for set-foo-a-slow
; Size: 118 bytes. Origin: #x538D2E4D
; 4D:       488975F0         mov [RBP-16], RSI                ; no-arg-parsing entry point
; 51:       4C8945F8         mov [RBP-8], R8
; 55:       4883EC10         sub RSP, 16
; 59:       498BD0           mov RDX, R8
; 5C:       488B3D9DFFFFFF   mov RDI, [rip-99]                ; 'a
; 63:       B904000000       mov ECX, 4
; 68:       48892C24         mov [RSP], RBP
; 6C:       488BEC           mov RBP, RSP
; 6F:       E8445FD4FC       call #x50618DB8                  ; #<fdefn shape>
; 74:       480F42E3         cmovb RSP, RBX
; 78:       4C8B45F8         mov R8, [RBP-8]
; 7C:       488B75F0         mov RSI, [RBP-16]
; 80:       498B4005         mov RAX, [R8+5]
; 84:       4889749001       mov [RAX+RDX*4+1], RSI
; 89:       4C8945F8         mov [RBP-8], R8
; 8D:       4883EC10         sub RSP, 16
; 91:       498BD0           mov RDX, R8
; 94:       488B3D65FFFFFF   mov RDI, [rip-155]               ; 'a
; 9B:       B904000000       mov ECX, 4
; A0:       48892C24         mov [RSP], RBP
; A4:       488BEC           mov RBP, RSP
; A7:       E80C5FD4FC       call #x50618DB8                  ; #<fdefn shape>
; AC:       480F42E3         cmovb RSP, RBX
; B0:       4C8B45F8         mov R8, [RBP-8]
; B4:       498B4005         mov RAX, [R8+5]
; B8:       488B549001       mov RDX, [RAX+RDX*4+1]
; BD:       488BE5           mov RSP, RBP
; C0:       F8               clc
; C1:       5D               pop RBP
; C2:       C3               ret

速度は最適化された場合、大体4倍程度高速な様子(思ったより高速化されていない……)

(time 
 (let ((obj (make-instance 'foo)))
   (dotimes (i 1000000)
     (set-foo-a-fast obj))))
Evaluation took:
  0.053 seconds of real time
  0.050000 seconds of total run time (0.050000 user, 0.000000 system)
  94.34% CPU
  172,648,872 processor cycles
  0 bytes consed

(time (let ((obj (make-instance 'foo))) (dotimes (i 1000000) (set-foo-a-slow obj)))) Evaluation took: 0.210 seconds of real time 0.210000 seconds of total run time (0.210000 user, 0.000000 system) 100.00% CPU 692,425,819 processor cycles 0 bytes consed

そもそも高速なstandard-instance-accessを使ってしまっているのでslot-valueでのアクセスと比較してみます。

(defun set-foo-a/slot-name (obj value)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (setf (slot-value obj 'a) value)
  (slot-value obj 'a))

(time (let ((obj (make-instance 'foo))) (dotimes (i 1000000) (set-foo-a/slot-name obj))))

Evaluation took: 0.064 seconds of real time 0.060000 seconds of total run time (0.060000 user, 0.000000 system) 93.75% CPU 211,657,683 processor cycles 0 bytes consed

猛烈に遅くなる予想でしたが、slot-valueのスロット名がコンパイル時に確定しているため最適化されてしまい、shapeの速い方とほぼ同じ速度です。

; disassembly for set-foo-a/slot-name
; Size: 69 bytes. Origin: #x538D31AA
; AA:       488945F8         mov [RBP-8], RAX                 ; no-arg-parsing entry point
; AE:       4883EC10         sub RSP, 16
; B2:       488BD7           mov RDX, RDI
; B5:       488BF8           mov RDI, RAX
; B8:       B904000000       mov ECX, 4
; BD:       48892C24         mov [RSP], RBP
; C1:       488BEC           mov RBP, RSP
; C4:       E80F6FD4FC       call #x5061A0D8                  ; #<fdefn (sb-pcl::slot-accessor :global a sb-pcl::writer)>
; C9:       480F42E3         cmovb RSP, RBX
; CD:       488B45F8         mov RAX, [RBP-8]
; D1:       4883EC10         sub RSP, 16
; D5:       488BD0           mov RDX, RAX
; D8:       B902000000       mov ECX, 2
; DD:       48892C24         mov [RSP], RBP
; E1:       488BEC           mov RBP, RSP
; E4:       E8CF6ED4FC       call #x5061A0B8                  ; #<fdefn (sb-pcl::slot-accessor :global a sb-pcl::reader)>
; E9:       488BE5           mov RSP, RBP
; EC:       F8               clc
; ED:       5D               pop RBP
; EE:       C3               ret

ということで遅くするために実行時にスロット名を与えることにしてみます。

(defun set-foo-a/slot-name/ (obj value name)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (setf (slot-value obj name) value)
  (slot-value obj name))

(time (let ((obj (make-instance 'foo))) (dotimes (i 1000000) (set-foo-a/slot-name/ obj 42 'a))))

Evaluation took: 0.105 seconds of real time 0.100000 seconds of total run time (0.100000 user, 0.000000 system) 95.24% CPU 346,033,917 processor cycles 0 bytes consed

どうやら色々最適化してくれるようでSBCLの場合は大して遅くならないようです……。

まとめ

Rubyオブジェクトの未来をつくる「シェイプ」をCommon Lispで真似してみました。
Common Lispの場合は、オブジェクトの内部配列にインデックスでアクセスするという機構は既に備わっているので何も考えずにslot-valueで書いても最適化で高速化されることが多いようです。

標準的でないメタクラスや総称関数を定義した場合は、これらの最適化が外れることが多くなるとは思いますが、恐らく普通のオブジェクト指向プログラミングをする範囲では十分に速いものになるかと思います。


HTML generated by 3bmd in LispWorks 7.0.0

Metaobject Protocol及び関連技術についての個人的まとめ

Posted 2021-09-04 06:37:35 GMT

個人的にはMetaobject Protocol(MOP)という技術は好きなのですが、壮大な機構として捉えられがちな割には応用が大したものでもなかったりする印象を持ちます。
今回は、その辺の個人的考えをまとめてみたいと思います。

MOPという技術の大枠(壮大)

個人的には、LispのMOPは、Lispのインタプリタ(eval)をオブジェクト指向プログラミング的に展開したもの、と最近は考えています。

CLOSとそのMOPの初期の頃の文献を参照するとProceedings of the First CLOS Users and Implementors Workshop 1988の中のThe Importance of Being Metaで、Lispらしいオブジェクト指向プログラミングシステムの探求のようなことが書かれています。骨子は、

  • LispではDSLの構築において、Lisp自身を拡張する、Lispに埋め込むというアプローチが柔軟にできるのが言語の特長
  • CommonLoops(CLOS)は、Flavorsや LOOPSと違ってこのLispらしさを追求する

というところですが、どうやら当時のXerox近辺では、CLOSという用語をCommon Lispの方言の一つ(=別言語)という機微で使っているように思えます。
説明の都合上かもしれませんがこの文脈での、Common Lispという用語はCLtL1=Common Lisp 1984=これまでのLispの代表、のような機微を感じます。
ちなみに、オブジェクト指向プログラミングの本を読んでいると、CLOSという言語が独立して存在するかのような記述が散見されますが、1990年代前半のXerox近辺の活動の影響なのかと思わなくもありません(もしくはLispベンダーのマーケティングか)

閑話休題。さて、Lispらしさを追求するというCLOSは、FlavorsやLOOPSと何が違うのか、ということになりますが、その違いがMOPになります。
FlavorsやLOOPSは、既存のLisp処理系の上に構築したDSL/アドオンという形態ですが、MOPはLisp本来の力を引き出すという主張があり、CLOSは極端に説明すると、メタオブジェクトで構成されたインタプリタ(eval)を核とする新しいLisp方言という方向性だったのではないかと思います。

古典的なLispでは、eval万能関数が、データを処理していきますが、このevalにオブジェクト指向技術を適用するというイメージかと想像しています。

面白いのは、Smalltalk誕生のきっかけになったLispからの影響としてアラン・ケイは、全体をfexpr化したevalというのを挙げています。

Smalltalkの歴史のII. 1967-69—The FLEX Machine, a first attempt at an OOP-based personal computerあたりで述べられていますが、evalが関数(引数を評価した後手続き処理する)と特殊形式/fexpr(手続きが引数の評価も担当する)に分けているところを全面的にfexpr化することを考えた結果、オブジェクトが渡されたメッセージをオブジェクト自身が評価する→メッセージ送信を核とするオブジェクト指向、という風に概念が整理されたようです。そういう意味では、MOPはオブジェクト指向プログラミングシステムとしても原点回帰だったのではないでしょうか。

MOPと関連技術(大き目な流れ)

Open Implementation(OI)

Kiczales先生は後にMOPの仕事をLisp以外にも応用するという流れで、1990年代中半あたりまで、Open Implementationという技術を追求します。
これはMOPで展開されたようなメタオブジェクトでプロトコル化されたアプローチをLisp以外のメジャーなコンパイラ言語などにも適用するというものだったと思いますが、後のアスペクト指向プログラミングのようにブームになるようなことはなかったようです。

アスペクト指向プログラミング(AOP)

Kiczales先生は、1990年代中半以降、OIからAOPに研究主軸を移しますが、この辺りの連続性は私は詳しく追えていません。
OIや、MOP技術の応用事例として、プログラミングにまつわる横断的な問題をアスペクトとして切り出し対処するのがAOPなのか、はたまた逆なのか、似ているけれど根本は違うのか。
また、AOPとリフレクション技術も一緒に語られることが多いと思いますが、これは、メジャーな言語の多くはLisp等のevalな背景を持つ言語とは違い、プログラミング→コンパイル→実行、というバッチ指向であり、実行→コンパイル→プログラミングという遡り操作の実現が殊更難しいために技術的挑戦/研究が発展することになったのかと思います。

柔軟な言語をいかに速くするかと、速い言語をいかに柔軟にするかは、大体似たような技術になるのかとは思いますが、柔軟な言語の利用者からすると何故そのような技術が必要とされるのかの動機の理解が難しいことも多い気がします。

Lispは手続きの実行に柔軟にフックを掛けることが可能なのですが、アドバイス機構やマクロでAOPを真似ることができることをもって「Common LispはAOPが実現できている」という人もいます。しかし、個々のフックをアスペクトという視点で切り出して操作するようなフレームワークも存在しませんし、飽く迄AOPのようなことも個別に記述すれば可能、程度のことかと思うのでAOPをサポートしているとはいいがたいと思います。

MOPとオブジェクト指向システム(中くらい)

Lispらしさを追求し、Flavorsのようなアドオンではない、という当初のCLOSでしたが、結局のところANSI Common LispではMOPが規格に入らなかったため、Common Lispのオブジェクト指向システムは既存のFlavorsのようなアドオンと大差ないものとなりました。

とはいえ、MOPありで規格化されたとしても、急進的にevalにまでMOPが適用されるということもなかったと思います。
結果的にはANSI Common Lisp+MOPでは、データ定義/操作の側と手続き呼び出しの操の系統の二系統がevalの外側にユーザー拡張機能として装着されていて、それより外側でカスタマイズができる、という風になっています。

総称関数が関数呼び出しの機構に若干食い込んではいますが、MOP全面的に適用されていれば、また違った形態になったでしょうし、evalや、compileがMOP化されていれば、コンパイラの最適化等もユーザーが柔軟にカスタマイズ可能になったと思われます。
このような形態が恐らくOpen Implementation化されたCommon Lispだったのかと推測します。恐らくOI化されたCLではAOPを組込むのもさらに容易であったでしょう。

メタクラスのカスタマイズ(小さい流れ)

さてMOPの応用事例として、データ生成にまつわる一連の流れのカスタマイズと、手続き呼び出しのカスタマイズがあります。 これらは、データ生成をするデータ(メタオブジェクト)を操作する手続きの一連の規約(Metaobject Protocol)のカスタマイズとして操作しますが、基本的には一連のデータ操作においてフックできるポイントがあり、このフックをOOP的に拡張することによりカスタマイズができる、というところになります。

MOPの応用にも、大き目のものから小さ目のものまでありますが、大きいものから順に列挙してみましょう。

MOPでオブジェクト指向システムや類似のシステムを構築する

1980年代のLispの需要として、エキスパートシステムの構築の核言語というものがありました、ミンスキー先生のフレーム理論のシステムをLisp上に構築するようなことは多く行なわれていましたが、フレームシステムはオブジェクト指向システムと非常に似たところがありこれらを構築するのにCLOSの機能はよく活用されています。ただ、Flavors等でも似たようなことは実現されていましたので、より柔軟にアプローチできるようになった、程度でしょうか。
一応MOPサポートの強みとしては、それ自身が柔軟に変更可能であるため、基盤となるオブジェクト指向システムから乖離しているような機構でも差分を吸収できるというのはあると思います。

実際、オブジェクト指向システムをCommon Lisp+MOPで構築したという例では、CommonObjectsやObject LISPが古くから知られており、MOPの柔軟性の証左ともされています。

また、セマンティックウェブのOWL処理系をCommon Lisp上に構築したSWCLOSのようなものもあります。

ほか参照

入出力のフック

メタクラスの応用としては最も古くから存在し典型的なものとしてオブジェクトの永続化があります。
エキスパートシステムで利用するフレームのデータを格納する手段として出発し発展してきましたが、大抵は永続化用のメタクラスを定義し、ユーザーはそれを意識することなしにシステムが勝手に永続化しているようなシステムの実現に使われます。

古くは、HPのPCLOS(1988)からありますが、最近のAllegro CLのように処理系と統合されていることもあります。

また、RDBとオブジェクト指向システムを透過的に接続するORMも類似の技術ですが、こちらの実現にも良く使われています。

雑多なフックや挙動のカスタマイズ

雑多なフックや挙動のカスタマイズは多数ありますが、Common Lisp自体の柔軟性が高いためMOPを使わなくとも別の手段で実現できてしまうことが殆どです。

  • フレームを実現するためにスロット以外に属性を持たせる
  • GoFデザインパターンに代表されるOOPのイディオムををMOPでユーザー透過な組み込みの機能として実現する
  • オブジェクトのプールを作成したりオブジェクトを集計したりする

等々、細かいカスタマイズは沢山ありますが、当然ながら、MOPはオブジェクト指向システム固有の操作に近い部分のカスタマイズを得意としているかと思います。

まとめ

以上、長々と書いてきましたが、まとめると現在のANSI Common Lisp+MOPで可能な応用で最大のものは、オブジェクト指向システムやフレームシステムのCommon Lisp上での実現、最小のものはオブジェクト生成にまつわるちょっとしたフック、あたりになると思います。

究極形態としては、Open Implementation化されたCommon Lispだったと思うのですが、そういうCommon Lisp処理系がいつの日か登場すると面白いなと思います。


HTML generated by 3bmd in LispWorks 7.0.0

浮動小数点数のdescribe

Posted 2021-08-29 02:12:36 GMT

Lucid CLで浮動小数点数をdescribeすると気の効いた表示をしてくれるようなので、他の処理系はどうなのか調べてみました。
下記は、4.18695205d7describeした結果です。

Lucid CL

4.18695205E7 is a float.  It has 53 bits of precision.
The mantissa is 5619631913959424 and the exponent is -27.
(rational 4.18695205E7) is 83739041/2.
(rationalize 4.18695205E7) is 83739041/2.

Allegro CL

4.18695205d+7 is a NEW DOUBLE-FLOAT.
 The hex representation is [#x4183f706 84000000].

Armed Bear CL (ABCL)

4.18695205d7 is an object of type DOUBLE-FLOAT.

CLISP

4.18695205d7 is a float with 53 bits of mantissa (double-float).

Clozure CL

Float: 4.18695205D+7
Scientific: 4.19D+7
Log base 2: 25.319397060287525D0
Ratio equiv: 83739041/2
Nearest integer: 41869520

CMU CL

4.18695205d7 is a DOUBLE-FLOAT.

ECL

4.18695205d7 - double-float
 exponent:  -27
 mantissa:  5619631913959424

Eclipse CL

4.1869520499999996d+7 is a DOUBLE-FLOAT at #x-3E1F3100:
  ECLIPSE::SIGNIFICAND: 5619631913959424
  ECLIPSE::EXPONENT: -27
  ECLIPSE::SIGN: 1.

GCL

4.18695205E7 - long-float
 exponent:  -27
 mantissa:  5619631913959424

LispWorks

4.18695205D7 is a DOUBLE-FLOAT

MCL

Double float:    4.18695205D+7
Scientific:      4.19D+7
Log base 2:      25.319397060287525D0
Ratio equiv:     NIL
Nearest integer: NIL

NIL

※ソースコードから復元した予想結果

4.18695205D7 is a double float.
  Sign bit: 1, excess-128 exponent: #x65, fraction bits: #x13F70684000000.

SBCL

4.18695205d7
  [double-float]

Symbolics CL

4.18695205d7 is a double-precision floating-point number.
  Sign 0, exponent 2030, 52-bit fraction 037560320400000000  (not including hidden bit)
  Its exact decimal value is 41869520.5d0

VAX LISP

It is the double-float 4.18695205d7
Sign:        +
Exponent:    26 (radix 2)
Significand: 0.6239044740796089

Xerox CL

a single-float, 
   sign: cl::positive
   radix: 2
   digits: 24
   significand: 0.62390447
   exponent: 26

(describe 41869520.5d0)と入力しているのだけれど……

まとめ

やはりLucid CLの結果が充実している様子。
Spice Lisp系(CMUCL、SBCL、LispWorks)は素気ない表示ですが、古くからある処理系の、MCL系(MCL、Clozure CL)、Symbolics CLあたりは色々な情報を教えてくれるようです。

ちなみに、この記事はこちらの浮動小数点数の誤差の記事(Abstract Heresies: A Floating-point Problem)で、41869520.5d0を有理数の記述するのに、(+ 41869520 1/2)という表現をつかっているのを目にして、そういえば、describerationalizeの結果を教えてくれる処理系があったような……と調べてみたのが切っ掛けでした。
この場合は、(= 41869520.5d0 (rationalize 41869520.5d0)) → Tであることを確認し、(rationalize 41869520.5d0)と記述すれば良さそうです。


HTML generated by 3bmd in LispWorks 7.0.0

(abs -0.0)の値

Posted 2021-08-25 01:30:35 GMT

Twitterで(abs -0.0)の値が話題になっていたので、Common Lispの処理系はどんな風になっているのか調べてみました。

-0.0 のサポート

まず、Common Lispでは-0.0をサポートしなくても良いようです。そもそもIEEE 754のサポートも必須ではなく、過去にはその辺りの選択は多分多様だったのでしょう。
IEEE 754をサポートしている場合には、*features*:ieee-floating-pointが入ることが推奨されています。

ちなみに実際に下記に出てくるVAX LISPなどはIEEE 754とは微妙に違う実装のようです。

VAX LISP[TM] V3.1
 Digital Equipment Corporation. 1989, 1990.
All Rights Reserved.

Lisp> *features* (EDITOR UIS COMPILER DEBUGGER :VMS VMS :DEC DEC :COMMON COMMON :VAX VAX :VAXLISP)

処理系が-0.0をサポートしているかどうかは、

(eql -0.0 0.0)
→ nil

かどうかで判定できると規格に書いてあります。

-0.0をサポートしていない処理系では、-0.0は、0.0として読み込まれるため、

(list -0.0L0 (abs -0.0L0))

の結果を確認すれば、(abs -0.0L0)の結果が正しいかを確認できそうです。

確認してみる

-0.0をサポートしている処理系

SBCL 1.4.8
(-0.0d0 0.0d0) → ok
CMUCL 21d
(-0.0d0 0.0d0) → ok
ABCL 1.7.0
(-0.0d0 0.0d0) → ok
ECL 21.2.1
(-0.0l0 0.0l0) → ok
MCL 3.0/5.2
(-0.0d0 0.0d0) → ok
LispWorks 7.1.3
(-0.0d0 -0.0d0) → ng
Lucid CL 4.1
(-0.0d0 -0.0d0) → ng

-0.0をサポートしていない処理系

Eclipse CL 1.1
(0.0d0 0.0d0)
CLISP 2.49.92
(0.0L0 0.0L0)
Allegro CL 10.1
(0.0d0 0.0d0)
Corman Lisp 3.1
(0.0d0 0.0d0)
AKCL 1.619
(0.0 0.0)
GCL 2.6.12
(0.0 0.0)
Xerox CL
(0.0 0.0)
VAX LISP
(0.0L0 0.0L0)

ということで、LispWorksとLucid CLだけ整合性がないという結果になりました。

まとめ

以上の結果が、Common Lispの規格として不整合なのかどうかはいまいち分からないのですが、LispWorksでも#C(-0.0 0)abs0.0だったりするようなので、float処理の場合だけ妙なことになっているのではないかと推察します。

(eql (abs #C(-0.0 0)) (abs #C(0.0 0)))
→ T

(eql (abs -0.0) (abs 0.0)) → nil

LispWorksにバグ報告してみたいような気もしますが、果してバグと言って良いのだろうか……。


HTML generated by 3bmd in LispWorks 7.0.0

CommonObjectsをつくろう(2)

Posted 2021-08-21 20:09:52 GMT

CommonObjectsの継承

CommonObjectsの継承は所謂多重継承をサポートしていますが、そもそも継承の仕組みがちょっと変わっていて、インスタンスは上位クラスで定義されたスロットを取捨選択して一本化するのではなく、上位クラスのスロット全部を保持します。
継承戦略として木構造を採用しているということみたいですが、詳細は下記の論文を参照してください。

上位クラスのスロットを保持させる

この辺りの詳細が不明なのでcoolの実装を眺めてみましたが、上位クラスの定義を全部インスタンス化して保持するという結構富豪的な解決方法を採っているようです。
coolは1986年時点のMOPの上に実装されているので、現在のCLOS MOPとは結構違いますが、バッキングストレージのベクタは、

  1. クラスオブジェクト
  2. 自分自身(self)
  3. 上位クラスのインスタンス
  4. スロットの値

を保持しています。
なお、上位クラスのインスタンスもまた同じ構造をしていますが、selfは上位クラスのものではなく元オブジェクトを指すようになっています。

とりあえず、今回はベクタの配置のオフセットの計算が面倒に感じたので、構造体を使うことにしてみました。 インスタンス内部のベクタを挿げ替える方法はポータブルではないので、allocate-instanceで親オブジェクトを生成してテーブルに保持しておく、という方法でも良いかなと思います。

;;; https://github.com/g000001/slotted-objects を利用

(defstruct (common-objects-object-storage 
            (:constructor allocate-common-objects-object-storage))
  (self nil)
  (parents '())
  (slots nil))

(defun common-objects-class-precedence-list (class) (let* ((cpl (class-precedence-list class)) (pos (position (find-class 'common-objects-object) cpl))) (subseq cpl 0 (or pos 0))))

(defmethod allocate-instance ((class common-objects-class) &rest initargs) (let* ((storage (allocate-common-objects-object-storage)) (inst (slotted-objects:allocate-slotted-instance (slotted-objects:class-wrapper class) storage)) (baseclass (find-class 'common-objects-object))) (setf (common-objects-object-storage-self storage) inst) (setf (common-objects-object-storage-slots storage) (make-array (length (class-slots class)) :initial-element *undefined-slot-value*)) (setf (common-objects-object-storage-parents storage) (loop :for c :in (cdr (common-objects-class-precedence-list class)) :until (eql baseclass c) :collect (let* ((parent (make-instance c)) (parent-storage (slotted-objects:instance-slots parent))) (setf (common-objects-object-storage-self parent-storage) inst) parent))) inst))

(defmethod slot-value-using-class ((class common-objects-class) instance (slotd slot-definition)) (elt (common-objects-object-storage-slots (slotted-objects:instance-slots instance)) (slot-definition-location slotd)))

(defmethod (setf slot-value-using-class) (value (class common-objects-class) instance (slotd slot-definition)) (setf (elt (common-objects-object-storage-slots (slotted-objects:instance-slots instance)) (slot-definition-location slotd)) value))

親のスロットとマージしないようにする

親クラスのインスタンスをそのまま保持する方式のため、Common Lispのデフォルト動作であるスロット定義の一本化をやめるようにします。

(defmethod compute-slots ((class common-objects-class))
  (mapcar (lambda (slotd)
            (compute-effective-slot-definition class
                                               (slot-definition-name slotd)
                                               (list slotd)))
          (class-direct-slots class)))

そして、その代りに親インスタンスのスロットを参照できるようなユーティリティを定義しておきます。

(defun parent-instance (inst type)
  (find type (common-objects-object-storage-parents (slotted-objects:instance-slots inst))
        :key #'type-of))

:inherit-from オプションの処理

これだけでは不十分ですが、暫定的な定義としてこんな感じにします。

(defun process-inherit-from (slots)
  (let ((ans '()))
    (dolist (s slots)
      (typecase s
        ((cons (eql :inherit-from) *) 
         (push (elt s 1) ans))))
    (or (nreverse ans)
        (list 'common-objects-object))))

動作確認

上記の定義で、下記のような処理ができるにはなりました。

(define-type a
  (:var a (:init 0))
  :all-settable)

(define-type b (:var b (:init 1)) (:inherit-from a) :all-settable)

(=> (make-instance 'b) :b) → 1

(=> (make-instance 'b) :a) !!! slot-missing

(=> (parent-instance (make-instance 'b) 'a) :a) → 0

さてしかし、CommonObjectsでは、上位クラスのメソッドは継承してくる(しかし同名メソッドは複数あるとクラス定義不可)ので、継承してきた:aメソッドが機能する必要があります。

(=> (make-instance 'b) :a)
→ 0

となれば良いのですが、これをどう実現したものか。

とりあえず、slot-missingで転送すれば似た挙動にすることは可能ですが、メソッドの継承回りをちゃんと作らないと上手く機能しなさそうです。

(defmethod slot-missing ((class (eql (find-class 'race-hourse)))
                         instance
                         slot-name
                         operation
                         &optional new-value)
  (ecase operation
    (slot-value (slot-value (parent-instance instance 'animal) slot-name))
    (setf (setf (slot-value (parent-instance instance 'animal) slot-name)
                new-value))))

(=> (make-instance 'b) :a) → 0

まとめ

継承まわりの設計はマニュアルではあまり説明されていないので、CommonObjectsの論文を読んだりしてどのような設計なのかを探る必要がありそうです。


HTML generated by 3bmd in LispWorks 7.0.0

CommonObjectsをつくろう(1)

Posted 2021-08-05 04:37:09 GMT

前回は、クラス定義のdefine-typeとメッセージ送信構文の=>あたりを適当に辻褄を合せて作りましたが、マニュアルを読み進めて、define-methodあたりまでを作成してみます。

全スロット定義に関するオプション

CommonObjectsではFlavorsと同じくアクセサを一括で作成する機能があるようです。gettablesettableinitableというのも同じですが、Flavorsではinitableのスペルがinittableだったりinitableだったりします。initableなのは、gettablesettableと文字数を合せたかったからなのでしょうか……。

このオプションの処理をどこに加えようかと考えましたが、とりあえず、define-typeのマクロに押し込めてしまうことにしました。
後々適切なプロトコルを思い付いたらそちらで処理します。

(defmacro define-type (type-name &optional doc-string &body slots &environment environment)
  (declare (ignore environment))
  (if (typep doc-string 'string)
      (setq slots (cdr slots))
      (setq slots (cons doc-string slots)
            doc-string nil))
  (let ((slots (copy-tree (remove-if #'keywordp slots)))
        (opts (remove-if (complement #'keywordp) slots)))
    (dolist (s slots)
      (when (find :all-initable opts)
        (push :initable (cddr s)))
      (when (find :all-gettable opts)
        (push :gettable (cddr s)))
      (when (find :all-settable opts)
        (push :settable (cddr s))))
    `(ensure-common-objects-class ',type-name
                                  :documentation ,doc-string
                                  :direct-slots (list ,@(mapcar #'parse-slot slots)))))

メソッド定義構文: define-method

CommonObjectsは総称関数ベースではなくシングルディスパッチのため、前回適当に作成した=>というメッセージ送信の総称関数にどんどんメソッドを足していくことでも何とかなりそうです。
ということでこのように書いてみました。

(defmacro define-method ((type message) (&rest args) &body body)
  (let ((slots (mapcar #'slot-definition-name (class-slots (find-class type)))))
    `(defmethod => ((obj ,type) (msg (eql ,message)) &rest args)
       (let ((self obj))
         (declare (ignorable self))
         (destructuring-bind (,@args) args
           (with-slots ,slots obj
             (declare (ignorable ,@slots))
             ,@body))))))

特徴的なのは、define-methodの内部では、インスタンスのスロットが変数のようにみえる点ですが、この辺りもFlavorsというか一般的なオブジェクト指向言語風です。自身を指す変数であるselfも用意されています。

class-slotswith-slotsを組合せて使っていますが、原理的にdefine-methodの定義時にクラスのスロットが確定している必要があります。
CommonObjectsはあまり動的ではなさそうにみえるので、多分これで大丈夫でしょう。
ちなみに、全部実行時に持っていくとすると、progv等を使うことになりそうです。

スロットが初期化されない場合

Common Lisp標準では、スロットは未束縛の状態を持ちますが、CommonObjectsでは未定義値が入るようです。
実装としては、slot-unboundメソッドを定義したり、initialize-instanceで未定義値で初期化したりと色々な方策が考えられますが、今回は、allocate-instanceでCommonObjects用の未定義値を入れてみることにします。

(defstruct undefined-slot-value)

(defvar *undefined-slot-value* (make-undefined-slot-value))

(defmethod allocate-instance ((class common-objects-class) &rest initargs) (let ((instance (call-next-method))) (dolist (s (class-slots class)) (setf (slot-value-using-class class instance (slot-definition-name s)) *undefined-slot-value*)) instance))

動作確認

マニュアルにある例を動かして確認してみます

(define-type vector-instance
  (:var theta (:type float) (:init 0))
  (:var magnitude (:type float))
  :all-settable)

(define-method (vector-instance :scale) (x) (setq magnitude (* x magnitude)))

(=> (make-instance 'vector-instance) :scale 3) !!! In * of (3 #S(undefined-slot-value)) arguments should be of type number.

(define-type bank-account
  (:var holder (:type simple-string))
  (:var acct-num)
  (:var balance (:type number))
  :all-initable
  :all-gettable)

(defun open-account (name number initial-balance) (if (and (simple-string-p name) (numberp initial-balance) (> initial-balance 0)) (make-instance 'bank-account :holder name :acct-num number :balance initial-balance) (error "Bad name: ~A or Balance: ~A " name initial-balance)))

(setq acct1 (open-account "Bobby Brown" '555-55-5555 100.00)) → #<bank-account 40100FA453>

(=> acct1 :balance ) → 100.0

(define-method (bank-account :deposit) (amount) (if (and (numberp amount) (> amount 0)) (setf balance (+ balance amount)) (error "Bad deposit amount ~A" Amount)))

(=> acct1 :deposit 50) → 150.0

(=> acct1 :balance) → 150.0

(define-method (bank-account :withdraw) (amount) (cond ((or (not (numberp amount)) (< amount 0)) (error "Improper Withdrawal Amount ~A" amount)) ((< balance amount) (error "Insufficient Funds -- Transaction denied")) (T (setf balance (- balance amount)))))

(=> acct1 :withdraw 25) → 125.0

(=> acct1 :balance) → 125.0

まとめ

MOPがサポートされていると標準以外のオブジェクト指向システムを構築していくのも比較的簡単な気がしてきました。
今後のドメイン特化オブジェクト指向システム時代の到来を期待したい……。

次回は、継承まわりを実装してみます。


HTML generated by 3bmd in LispWorks 7.0.0

CommonObjectsをつくろう(0)

Posted 2021-08-02 01:30:52 GMT

先日bitsaversにHP Common Lisp(HPCL)のマニュアルがアップされました。

HPCLには二種類の系統があり、ユタ大学のPortable Standard Lisp(PSL)のエコシステム一式がCommon Lisp化した最初の版と、Lucid社のOEM処理系で実質Lucid CLの第二版があります。

今回アップロードされたマニュアルは、PSLベースのもので、独自の系統だけに結構貴重です(Lispマニア的には)。

ユタ大学のPSLのエコシステムには処理系以外にもエディタや、オブジェクト指向システム、エキスパートシステムのツールキット等が1980年代中半までには確立していたようなのですが、その辺りの一式もCommon Lispに移植されていたようです。

アップロードされたマニュアルの一つにNMODEというLisp実装のEmacsのマニュアルが含まれていますが、元はPSL上で稼動していたものの様子

1980年代中後半の商用Lispシステムといえば、エキスパートシステム需要が大きかったことを反映してか、定番構成として、

  • Lisp処理系
  • Lisp向けエディタ(大抵Emacs)と対話的開発環境
  • エキスパートシステムツールキット(前向き/後向き推論)
  • フレームシステム(オブジェクト指向システム)
  • 知識ベースシステム(データベース)

のようなものが鉄板だったようです。HPもHP 9000/300を中心にそのようなLispシステムの販売を展開していた様子。

CommonObjects

そんなHPCLですが、マニュアルを眺めてみるとオブジェクト指向システムとしてCommonObjectsとみられる解説がありました。

CommonObjectsは、Common Lispのオブジェクト指向システムの歴史には良く出てくるシステムなのですが、オンラインで入手できる文献が非常に少ないので、こちらも結構貴重です。

1987年にPortable CommonLoops上にCommonObjectsを実装したcoolというのがあり、個人的にANSI CLで動くようにしてみていたことがありますが、マニュアルをざっと眺める限り大体の機能はCLOS MOPで実装できそうな気がするので、適当にCommonObjectsを再現していくことにしました。

クラス定義構文の実装

何も考えずにマニュアルの先頭から実装していきますが、まずは、define-typeというdefclassに相当する機能の説明があるので、これを作成してみようと思います。
define-type構文は眺める限り、standard-classや、standard-slot-definition以上の機能は特にないようです。
gettablesettableinitableのオプションはFlavorsの影響かなと思いますが、これはアクセサを生成するかどうかのオプションです。

ということで、マニュアルの冒頭を適当に動かして遊んでみるレベルから開始すると下記のようになりました。

(defpackage "https://github.com/g000001/zrco"
  (:use)
  (:export
   =>
   apply-method
   assignedp
   call-method
   define-method
   define-type
   instance
   instancep
   ;; make-instance
   rename-type
   self
   send?
   supports-operation-p
   undef
   undefine-method
   undefine-type
   import-specialized-functions
   ))

(defpackage "https://github.com/g000001/zrco#internals" (:use "https://github.com/g000001/zrco" c2cl) (:shadowing-import-from "https://github.com/g000001/zrco" call-method))

(cl:in-package "https://github.com/g000001/zrco#internals")

(defclass common-objects-class (standard-class) ())

(defmethod validate-superclass ((sub common-objects-class) (sup standard-class)) T)

(defclass common-objects-object (standard-object) () (:metaclass common-objects-class))

(defclass common-objects-direct-slot-definition (standard-direct-slot-definition) ((init :initarg :init) (var :initarg :var) (initable :initarg :initable :reader slot-definition-initable) (gettable :initarg :gettable :reader slot-definition-gettable) (settable :initarg :settable :reader slot-definition-settable)))

(defun make-keyword (name) (intern (string name) :keyword))

(defgeneric => (obj msg &rest opts))

(defgeneric (setf =>) (val obj msg &rest opts))

(defmethod initialize-instance ((class common-objects-direct-slot-definition) &rest initargs &key (init nil initp) initable var gettable settable) (when (or settable gettable) (eval `(defmethod => ((obj common-objects-object) (msg (eql ,(make-keyword var))) &rest opts) (slot-value obj ',var)))) (when settable (eval `(progn (defmethod (setf =>) (val (obj common-objects-object) (msg (eql ,(make-keyword var))) &rest opts) (setf (slot-value obj ',var) val)) (defmethod => ((obj common-objects-object) (msg (eql ,(make-keyword (concatenate 'string (string 'set-) (string var))))) &rest opts) (setf (slot-value obj ',var) (car opts)))))) (apply #'call-next-method class (append (and var `(:name ,var)) (and initp `(:initform ,init)) (and initp `(:initfunction ,(lambda () init))) (and (or initable gettable settable) `(:initargs (,(make-keyword var)))) initargs)))

(defmethod direct-slot-definition-class ((class common-objects-class) &rest initargs) (find-class 'common-objects-direct-slot-definition))

(defun parse-slot (slot-form) (destructuring-bind (var name &rest opts) slot-form (check-type var (eql :var)) (check-type name symbol) (list* 'list :name `',name ;kludge :var `',name (mapcan (lambda (s) (typecase s (keyword (list s T)) (cons (copy-list s)))) opts))))

(defun ensure-common-objects-class (name &rest args &key environment documentation direct-slots &allow-other-keys) (declare (ignore environment)) (apply #'ensure-class-using-class (class-prototype (find-class 'common-objects-class)) name :documentation documentation :direct-superclasses (list (find-class 'common-objects-object)) :direct-slots direct-slots :metaclass (find-class 'common-objects-class) args))

(defmacro define-type (type-name &optional doc-string &body slots &environment environment) (declare (ignore environment)) (if (typep doc-string 'string) (setq slots (cdr slots)) (setq slots (cons doc-string slots) doc-string nil)) `(ensure-common-objects-class ',type-name :documentation ,doc-string :direct-slots (list ,@(mapcar #'parse-slot slots))))

=>(send)を定義する場所がinitialize-instanceの中というのも変ですが、initialize-instanceの中でdefmethodを呼ぶのもまた嫌です。
しかし、make-methodで扱うmethod-functionの引数の形式がポータブルでなかった気がするので、defmethodにしました。
また、毎度のことですが、構文のスコープの扱い(名前⇔オブジェクト)が面倒臭いです。この辺りは、Schemeのようにオブジェクトだけだと統一感もあって楽なのですが。

試してみる

define-type構文が作るスコープの詳細が不明なのですが、defunと同じく周囲の変数は取り込めるようにしてみました。

(define-type foo
  (:var x (:type 'list) (:init '(0 1 2 3)) :settable)
  (:var y (:type 'integer) (:init 0) :initable))

(let ((obj (make-instance 'foo :x '(0 0 0 0) :y 42))) (list (=> obj :x) (setf (=> obj :x) '(1 1 1 1)) (=> obj :x) (=> obj :set-x '(2 2 2 2)) (=> obj :x)))((0 0 0 0) (1 1 1 1) (1 1 1 1) (2 2 2 2) (2 2 2 2))

(let ((x 33)) (define-type bar (:var x (:init x) :settable)))

(=> (make-instance 'bar) :x) → 33

まとめ

色々、改善したい点はありますが、とりあえずは、マニュアルの内容が一式動くようになるまで雑に作ってみたいと思います。


HTML generated by 3bmd in LispWorks 7.0.0

リストの破壊的反転でループアンローリング

Posted 2021-07-19 03:09:10 GMT

bit 1982年6月号の有澤誠先生の記事「トーイプログラム・ライブラリから (13) 線形リストの反転」で、リストの破壊的反転関数にループアンローリングを適用し一時変数への代入の回数を減らす手法が紹介されていたので、どんなものか試してみました。

ちなみにどうやらこちらの記事は、文中で紹介されている論文のネタをそのまま紹介している様子で論文は現在PDFで入手可能です。

ループアンローリングで代入を減らす

先に代入を減らしたものから紹介してみますが、こんな風になっています

(defun rev/ (list)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (declare (type list list))
  (let ((q list)
        (p nil)
        (r nil))
    (declare (type list p q r))
    (loop
     (macrolet ((relink (a b c)
                  `(progn
                     (when (null ,b)
                       (return ,a))
                     (setq ,c (cdr ,b))
                     (setf (cdr ,b) ,a))))
       (relink p q r)
       (relink q r p)
       (relink r p q)))))

そして、アンローリングしないものは下記のようになりますが、ループ内の三つの変数に固定した役割を与えるために変数名の付け替えを行なっているのを、無駄なのでやめた結果が上記のアンローリングした格好になっています。

(defun rev (list)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (declare (type list list))
  (let ((q list)
        (p nil)
        (r nil))
    (declare (type list p q r))
    (loop
     (macrolet ((relink (a b c)
                  `(progn
                     (when (null ,b)
                       (return ,a))
                     (setq ,c (cdr ,b))
                     (setf (cdr ,b) ,a))))
       (relink p q r)
       (setq p q)
       (setq q r)))))

アンローリングの効果はあるのか

LispWorksとSBCLで計測してみました。
参考にnreconcとも比較してみています。(nreverseだとリスト以外のsequenceにも対応しているため)

(defparameter *big-list* 
  (loop :repeat 10000 :collect (random 100)))

(let ((u *big-list*)) (time (dotimes (n 100000 (car u)) (setq u (rev u)))))

(let ((u *big-list*)) (time (dotimes (n 100000 (car u)) (setq u (rev/ u)))))

(let ((u *big-list*)) (time (dotimes (n 100000 (car u)) (setq u (nreconc u nil)))))

LispWorks

rev:
User time    =        2.930
System time  =        0.010
Elapsed time =        2.933
Allocation   = 138559752 bytes
0 Page faults
Calls to %EVAL    1800037

rev/: User time = 2.600 System time = 0.000 Elapsed time = 2.591 Allocation = 138568168 bytes 0 Page faults Calls to %EVAL 1800037

nreconc: User time = 5.110 System time = 0.000 Elapsed time = 5.099 Allocation = 138573152 bytes 0 Page faults Calls to %EVAL 1900037

SBCL

rev:
Evaluation took:
  1.530 seconds of real time
  1.530000 seconds of total run time (1.530000 user, 0.000000 system)
  100.00% CPU
  5,048,088,615 processor cycles
  0 bytes consed

rev/: Evaluation took: 1.230 seconds of real time 1.230000 seconds of total run time (1.230000 user, 0.000000 system) 100.00% CPU 4,071,225,671 processor cycles 0 bytes consed

nreconc: Evaluation took: 1.750 seconds of real time 1.740000 seconds of total run time (1.740000 user, 0.000000 system) 99.43% CPU 5,736,956,404 processor cycles 0 bytes consed

今回の例では、アンローリングしたものは、LispWorksで一割強、SBCLで二割強速くはなっているようですが、リストの大きさによっては殆ど速度が変わらないこともあるようです。微妙に速いかも、という程度でしょうか。

まとめ

最近のコンパイラだとこれくらいの最適化はされそうですが、とりあえずのところCommon Lispではまだ無理のようです。


HTML generated by 3bmd in LispWorks 7.0.0

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

Uncommon Lispの系譜

Posted 2021-07-06 20:13:07 GMT

Maybe julia stands for "Jeff's uncommon lisp is automated"?

Juliaコミュニティでuncommon lisp関係のもじりが産まれたようですが、昔からCommon Lispに対してUncommon Lispと言いたくなる人は出てくるようです。
一番有名なところでは、1985年のR2RSでしょうか。

1984に公の仕様となったCommon Lispが勢いのあった時期だけに、なにがCommon Lispじゃいと思っているLisp方言ユーザーも多かったのでしょう。

似たようなところでは、IBM LISP/370の開発記等もあります。

Lisp方言の名前に限らず、Uncommonなんとか、というのはLispのアプリケーション等でもたまに見掛ける命名法でもあります。

また、似た系統では、regexpに対して、irregexp等のようなものもあるようですが、普通とか共通というのに反発したくなっちゃう人が多いのかもしれません。


HTML generated by 3bmd in LispWorks 7.0.0

ifのelse部が可変長

Posted 2021-06-29 20:10:21 GMT

先日redditで、MACLISPの子孫でifのelse部が可変長なのを受け継いだのがEmacs Lispだけなのは何故かという質問がありました。

諸説ありますが、私は、「RMSの趣味」説を提唱したいです。

MACLISP系Lispのifの由来

ただその前にまずMACLISPのifがMACLISP系方言にMACLISPから伝搬していったという前提がまず微妙で、ifの仕様がMACLISPに由来するという前提がはっきりしなさそうです。

意外にもMACLISP系方言での標準的なifが成立するのは比較的新しく1978年あたりになりますが、現在メジャーなCommon LispやSchemeifの形式以外にバリエーションが多数ありました。

この辺りの流れをみると同時多発的にMACLISP方言にifが導入された様子で、下記の1978年のMACLISPのメーリングリストの議論を眺めるにその形式も揺れていたことがわかります。

そんなelse部が可変長のif形式ですが、少なくともLisp Machine LispとMACLISPでは採用されていました。MACLISPの方はいつ実装されたのかは不明なのですがLisp Machine Lispの方は記録が残っており、1979-07-20にAGRE氏によりelse部を可変長にしたらどうかという提案があったのを受けて、

RMSが1979-07-22日にLisp Machine Lispに機能を実装したようです。

I made the extension to IF for multiple else-clauses.
There seems to be no need for an IF-NOT macro when
(IF (NOT ...) ...) will work just as well with only 2 more characters.

拡張と書いているので、Lisp Machine Lispでは、当初は、Common Lispと同じifの形式だった可能性もあります。しかしこの時期のLispマシンのソースコードが残っていないので詳細は分からず……。

そしてこの可変長のelse部のifですが、Lisp Machine Manualを眺めるに賛否両論があった様子。

Chinual 2では可変長だという説明はありませんが、Chinual 4では、else部が可変長であることと、その利用についてはプログラミングスタイルとして賛否があるという記述があり、Chinual 5で可変長についての記述はまた消えます。

ただし記述は消えるものの、Lisp Machine Lispとしてはifのelse部は可変長であり続けたようでSymbolicsのZetalisp等も受け継ぎました。

RMSの一貫性

さてここでRMSですが、RMSの発言等を古いメーリングリストで眺めていると、RMSのLispについての好みは非常に一貫していて、後に自身が実装したLisp処理系であるEmacs Lispの仕様と照らし合わせてみても、まったくぶれがありません。

この辺りを鑑みるにLispマシングループでifのelse部の可変長について議論あった際にはRMSは可変長else派であったのではないでしょうか。
そして自らのLisp実装には可変長elseのifを採用するのは自然なのでEmacs Lispのifもelse部が可変長、ということになったのではないでしょうか。

以上が私の「ifのelse部が可変長なのはRMSの趣味」説です。

まとめ

RMSのLispの好みの一貫性については、非常に面白いのでいつかまとめてみたいところです。


HTML generated by 3bmd in LispWorks 7.0.0

Common Lispで多重な可変長引数

Posted 2021-06-19 18:16:27 GMT

InfoQ: Swift 5.4が複数の可変数引数、リザルトビルダなどをサポートの記事を読んで、lSwiftがCommon Lispでいう可変長なキーワード引数をサポートするようなのですが、Common Lispだとどんなことになるか真似してみることにしました。

その1: キーワード引数が可変長引数化するらしい

;// The third parameter does not require a label because the second isn't variadic.
;func splitVarargs(a: Int..., b: Int, _ c: Int...) { } 
;splitVarargs(a: 1, 2, 3, b: 4, 5, 6, 7)
;// a is [1, 2, 3], b is 4, c is [5, 6, 7].

一見して混乱の元に感じるのですが、Swiftだと便利な状況なのでしょう。
Common Lispだとキーワード引数は可変にすることはできません。

ただ下記のようにマクロのラムダ引数であればリストにできるので機能的に同等のものは書けるでしょう。

(defmacro split-varargs (&key ((:a (&rest a) nil)) b ((:c (&rest c) nil)))
  `(list ,@a ,b ,@c))

(split-varargs :a (1 2 3) :b 4 :c (5 6 7))(1 2 3 4 5 6 7)

(split-varargs :b 4 :a (1 2 3) :c (5 6 7))(1 2 3 4 5 6 7)

;splitVarargs(b: 4)
;// a is [], b is 4, c is [].

(split-varargs :b 4)(4)

twoVarargs()

(two-varargs) → nil

寧ろ括弧でグルーピングした方が読み易いのでは

その2: 固定長と可変長のキーワード引数を混在できる

固定長の場合、ラベル(キーワード)を省略できるそうなのですが、混乱しそうな機能をどんどん盛り込んでる気がしてならない……。

;// The third parameter does not require a label because the second isn't variadic.
;func splitVarargs(a: Int..., b: Int, _ c: Int...) { } 
;splitVarargs(a: 1, 2, 3, b: 4, 5, 6, 7)
;// a is [1, 2, 3], b is 4, c is [5, 6, 7].

;splitVarargs(a: 1, 2, 3, b: 4, 5, 6, 7)

(defmacro split-varargs (&key ((:a (&rest a) nil)) b ((:c (&rest c) nil)))
  `(list ,@a ,b ,@c))

(split-varargs :a (1 2 3) :b 4 :c (5 6 7))(1 2 3 4 5 6 7)

(split-varargs :b 4 :a (1 2 3) :c (5 6 7))(1 2 3 4 5 6 7)

;splitVarargs(b: 4) ;// a is [], b is 4, c is []. (split-varargs :b 4)(4)

固定長の方にはデフォルト値を与えることが可能

;// Note the third parameter doesn't need a label even though the second has a default expression. This
;// is consistent with the current behavior, which allows a variadic parameter followed by a labeled,
;// defaulted parameter, followed by an unlabeled required parameter.
;func varargsSplitByDefaultedParam(_ a: Int..., b: Int = 42, _ c: Int...) { } 

;func varargsSplitByDefaultedParam(_ a: Int..., b: Int = 42, _ c: Int...) { } 

(defmacro varargs-split-by-defaulted-param (&key ((:a (&rest a) nil)) (b 42) ((:c (&rest c) nil)))
  `(list ,@a ,b ,@c))

;varargsSplitByDefaultedParam(1, 2, 3, b: 4, 5, 6, 7) ;// a is [1, 2, 3], b is 4, c is [5, 6, 7].

(varargs-split-by-defaulted-param :a (1 2 3) :b 4 :c (5 6 7))(1 2 3 4 5 6 7)

;varargsSplitByDefaultedParam(b: 4, 5, 6, 7) ;// a is [], b is 4, c is [5, 6, 7].

(varargs-split-by-defaulted-param :b 4 :c (5 6 7))(4 5 6 7)

;varargsSplitByDefaultedParam(1, 2, 3) (varargs-split-by-defaulted-param :a (1 2 3))(1 2 3 42)

Common Lispの標準のラムダ引数では真似できないところ

自明なところで、ラベルを省略できる

;twoVarargs(1, 2, 3)

NG (two-varargs 1 2 3)

上記の場合、(two-varargs :a 1 2 3)(two-varargs 1 2 3)と書けたりするということなのですが、Common Lispの場合、引数をリストで受け取って全部自前で処理すれば可能ですが、組み込みの機能では無理です。
しかし、これも混乱の元になる機能のような……。

まとめ

キーワード引数で&restというのはCommon Lispでも実際に使っているのを目にしたことはありませんが、多分、見掛けが関数呼び出しに見えてしまうので避けられるのでしょう。


HTML generated by 3bmd in LispWorks 7.0.0

SRFI-1のbreakの使いどころ

Posted 2021-06-16 00:48:14 GMT

kyannyさんのサルでもわかる L-99 の P09を読んで、これはSRFI-1breakがうまくはまりそうな例だと思ったので試してみました。

SRFI-1のbreakとは、ある条件が成立するところを境にリストを二つに分け、それを多値で返すというものですが、個人的にはどこで使うんだろうという印象を持っていました。

(ql:quickload "srfi-1") ;ultralisp

(srfi-1:break (lambda (x)
                (not (equal 'a x)))
              '(a a a a b c c a a d e e e e))(a a a a)
  (b c c a a d e e e e)

breakを使えば、L-99のP09 packは、下記のように書けます。

(defun pack (list)
  (etypecase list
    (null '())
    (cons (multiple-value-call (lambda (head tail)
                                 (cons head (pack tail)))
            (srfi-1:break (lambda (x)
                            (not (equal (car list) x)))
                          list)))))

(pack '(a a a a b c c a a d e e e e))((a a a a) (b) (c c) (a a) (d) (e e e e))

#| ※3832840949 ;2021-06-16T2302 追記
一致しないもので二分するbreakより一致したもので二分するspanの方が素直ではないかとのご指摘を頂きました。確かに!

(defun pack (list)
  (etypecase list
    (null '())
    (cons (multiple-value-call (lambda (head tail)
                                 (cons head (pack tail)))
            (srfi-1:span (lambda (x)
                           (equal (car list) x))
                         list)))))

(pack '(a a a a b c c a a d e e e e))((a a a a) (b) (c c) (a a) (d) (e e e e))

※3832840949 ;2021-06-16T2302 追記 |#

SRFI-1はSchemeが本家本元なので、一応Racket(Scheme)でも書いてみました。

(require srfi/1)

(define (pack list) (if (null? list) '() (call-with-values (λ () (break (λ (x) (not (equal? (car list) x))) list)) (λ (head tail) (cons head (pack tail))))))

(pack '(a a a a b c c a a d e e e e)) → '((a a a a) (b) (c c) (a a) (d) (e e e e))

L-99の元ネタはPrologのP-99なのですが、P-99の模範回答でもbreakと同等の機能の下請け述語を定義してつかうようです。

ということで、なんとなくShenのProlog機能でbreakを定義してpackを書いてみました。

(defprolog break
  Item [] [] [] <--;
  Item [X|Xs] [] [X|Xs] <-- (when (not (= Item X)));
  Item [Item|Xs] [Item|Ps] Ys <-- (break Item Xs Ps Ys);)

(defprolog pack [] [] <--; [Item|Xs] [Ps|Zs] <-- (break Item [Item|Xs] Ps Ys) (pack Ys Zs);)

(prolog? (pack [a a a a b c c a a d e e e e] Xs) (return Xs)) → [[a a a a] [b] [c c] [a a] [d] [e e e e]]

まとめ

L-99に取り組み始めたのは、かれこれ14年前ですが、いまだに完遂していません……。


HTML generated by 3bmd in LispWorks 7.0.0

compiled-functionという型

Posted 2021-06-13 21:02:13 GMT

Common Lispにはcompiled-functionというコンパイル済みの関数という変った型がありますが、あまり活用されていないマイナー機能のためか最適化の指示等で使うと、最適化されそうな型名とは裏腹に最適化されないことがあったりします。

下記は現時点での最新のSBCL 2.1.5の例ですが、compiled-functionで型指定すると遅くなります。

(declaim (ftype (function (fixnum) fixnum) loop/function loop/compiled-function))

(defun loop/function (n) (declare (optimize (speed 3) (debug 0) (safety 0))) (if (zerop n) 0 (funcall (the function #'loop/function) (1- n))))

(defun loop/compiled-function (n) (declare (optimize (speed 3) (debug 0) (safety 0))) (if (zerop n) 0 (funcall (the compiled-function #'loop/compiled-function) (1- n))))

(time (loop/function #.(expt 10 10))) Evaluation took: 2.830 seconds of real time 2.820000 seconds of total run time (2.820000 user, 0.000000 system) 99.65% CPU 9,310,557,922 processor cycles 0 bytes consed

(time (loop/compiled-function #.(expt 10 10))) Evaluation took: 27.800 seconds of real time 27.780000 seconds of total run time (27.780000 user, 0.000000 system) 99.93% CPU 91,499,786,739 processor cycles 0 bytes consed

disassembleすると、loop/compiled-functionの方は末尾呼び出しにはなっているものの、単純ループにまでは最適化されていないことが判ります。

; disassembly for LOOP/FUNCTION
; Size: 22 bytes. Origin: #x536BA8A0                          ; LOOP/FUNCTION
; A0: L0:   4885D2           TEST RDX, RDX
; A3:       7409             JEQ L1
; A5:       488D42FE         LEA RAX, [RDX-2]
; A9:       488BD0           MOV RDX, RAX
; AC:       EBF2             JMP L0
; AE: L1:   31D2             XOR EDX, EDX
; B0:       488BE5           MOV RSP, RBP
; B3:       F8               CLC
; B4:       5D               POP RBP
; B5:       C3               RET

; disassembly for LOOP/COMPILED-FUNCTION ; Size: 35 bytes. Origin: #x536BA9C6 ; LOOP/COMPILED-FUNCTION ; C6: 4885D2 TEST RDX, RDX ; C9: 7508 JNE L0 ; CB: 31D2 XOR EDX, EDX ; CD: 488BE5 MOV RSP, RBP ; D0: F8 CLC ; D1: 5D POP RBP ; D2: C3 RET ; D3: L0: 4883C2FE ADD RDX, -2 ; D7: 488B05C2FFFFFF MOV RAX, [RIP-62] ; #<FUNCTION LOOP/COMPILED-FUNCTION> ; DE: B902000000 MOV ECX, 2 ; E3: FF7508 PUSH QWORD PTR [RBP+8] ; E6: FF60FD JMP QWORD PTR [RAX-3]

恐らくSBCLの型推論のバグだと思いますが、報告するのも面倒で、発見から早六年経過してしまいました。
もしかすると、compiled-functionが再帰で使われた際に自分がコンパイル済みかどうかは判定が微妙というのもあるのかもしれません。
とはいえ、functionで最適化できているのだから特に問題なさそうですし、SBCLはコンパイラ指向なので関数は全部コンパイルされると見做しても良さそうでもあります。

一応他の処理系でも試してみましたが、LispWorksではcompiled-functionでも単純ループに最適化されました(fixnumの指定に若干の変更あり)

Disassembly of loop/compiled-function
4020001734:
       0:      4157             push  r15
       2:      55               push  rbp
       3:      4889E5           moveq rbp, rsp
       6:      4989DF           moveq r15, rbx
L1:    9:      4883FF00         cmpq  rdi, 0
      13:      750E             jne   L2
      15:      31FF             xor   edi, edi
      17:      B901000000       move  ecx, 1
      22:      4889EC           moveq rsp, rbp
      25:      5D               pop   rbp
      26:      415F             pop   r15
      28:      C3               ret   
L2:   29:      4883EF08         subq  rdi, 8
      33:      EBE6             jmp   L1
      35:      90               nop   

まとめ

SBCLの処理系のコードを追い掛けてみると案外ややこしいのに加え、compiled-functionの指定など誰も使わなそうなのでバグ報告に至っていません。
誰かとりまとめて報告してみてください……。


HTML generated by 3bmd in LispWorks 7.0.0

(if (if ...

Posted 2021-06-06 20:48:53 GMT

なんとなく古いコードを眺めていて、ifの述語部にifが出てくるのを発見。
最近のコードにはあまり見掛けない気がするのですが、値を返すプログラミングスタイル(昔は適用型言語とも呼ばれた)らしいといえば、らしいので、どれくらい使われているのかざっと古いコードを検索してみました。
古いコードでは10万行中20〜30例位の頻度のようです。

具体的にどんなものがあるかというと、下記はNILのデバッガコマンドのコード中のもので、Zippy the Pinheadからの引用を表示するyowという謎コマンドですが(何故デバッガの機能として存在するのか)、 コマンド引数がnilなら、ランダムに引用し、引数で引用の番号が指定されているならば、範囲内かどうか調べ、表示するかエラーとするか、というものです。

(defun com-yow (arg &aux (n (simple-vector-length *yow*)))
  "Prints a Zippy the Pinhead quotation.
With no argument, one is selected at random;  with an argument, selects
that numbered one."
  (if (if (null arg) (setq arg (random n *yow-rs*)) (< -1 arg n))
      (dfmt "~&~A~%" (svref *yow* arg))
    (dfmt "  Out of range -- I know about ~D quotations.~%" n)))

類似の例としては、(if (or (and A B) ...や、(if (cond ...がありますが、(if (or (and A B) ...あたりは、たまに出来ちゃっていることもあるようなないような。

結構慣れないとぱっと思い付いて書くこともできなさそうですが機会があれば使っていきたいですね。


HTML generated by 3bmd in LispWorks 7.0.0

スコープも含めて式をコピーするエディタコマンドが欲しい

Posted 2021-05-25 19:16:48 GMT

Lispのコードを編集している時に式を外側に持ち出す時に囲んでいるスコープの変数も一緒に連れて行きたいことがたまにありました。

(defun foo (&aux x)
  (list x x x x))

(list x x x x)をコピーする際に、

(let ((x x))
  (list x x x x))

のように式がコピーできたら良いなというところですが、実験で変数環境を展開する無意味なマクロを作成している時に、これを応用すれば環境ごとコピーできるエディタコマンドが作成できるのでは、と思ったので作成してみます。

とりあえず、変数環境を展開する無意味な無意味なマクロとはこのようなものです。

#+LispWorks
(defmacro bind-env (&body body &environment env)
  `(let (,@(mapcar (lambda (x)
                     (if (walker:variable-special-p x env)
                         `(,x ,x)
                         `(,x ,x)))
                   (walker::env-lexical-variables env)))
     '.bind-env.
     ,@body))

LispWorks用ですが、大体の処理系に対応するAPIは備わっていますので移植は簡単です。
こんな感じに使いますが、マクロを展開すると、bind-envの周りの変数をletのフォームとして組み立てます。

(let ((x 42))
  (bind-env
    (list x x)))
===>
(let ((x 42))
  (let ((x x)) 
    '.bind-env.
    (list x x)))

エディタコマンドの作成

上記の謎マクロによって環境をletの式として表現できるようになったので、これをエディタのコマンドにしてみます。
LispWorksのHemlock用のコードですが、環境込みでマクロ展開した部分式をletで囲んだ文字列を作成するだけなので、SLIME等でも作成できると思います。

(defun toplevel-form-to-string (point)
  (let (str form-beg form-end)
    (with-defun-start-end-points (beg end :errorp nil) point
      (setq str (points-to-string beg end))
      (setq form-beg (copy-point beg))
      (setq form-end (copy-point end)))
    (values str form-beg form-end)))

(defun form-to-string (point) (let (str form-beg form-end) (save-excursion (with-point ((beg point)) (setq form-beg (copy-point beg)) (forward-form-command 1) (setq str (points-to-string beg (current-point))) (setq form-end (copy-point (current-point))))) (values str form-beg form-end)))

(defmacro bind-env (&body body &environment env) `(let (,@(mapcar (lambda (x) (if (walker:variable-special-p x env) `(,x ,x) `(,x ,x))) (walker::env-lexical-variables env))) '.bind-env. ,@body))

(defun extract-binds (form) (labels ((%extract-binds (form) (cond ((atom form) form) ((and (consp form) (eq 'let (elt form 0)) (equal ''.bind-env. (elt form 2))) (return-from extract-binds (elt form 1))) (T (%extract-binds (print (car form))) (%extract-binds (cdr form)))))) (%extract-binds form)))

(defcommand "Save Form With Env" (p) "Save Form With Env" "Save Form With Env" (declare (ignore p)) (multiple-value-bind (killed killed-beg killed-end) (form-to-string (current-point)) (with-point ((point (current-point))) (multiple-value-bind (whole whole-beg whole-end) (toplevel-form-to-string (current-point)) (declare (ignore whole)) (let* ((killed/env (concatenate 'string "(editor::bind-env " killed ")")) (whole/env (concatenate 'string (points-to-string whole-beg killed-beg) killed/env (points-to-string killed-end whole-end))) (expanded (with-compilation-environment-at-point (point) (walker:walk-form (read-from-string whole/env)))) (binds (format nil "~&(let ~A~% ~A)" (write-to-string (extract-binds expanded)) killed))) (set-current-cut-buffer-string (current-window) binds))))))

使ってみる

切り取り動作にするかコピー動作にするか迷いましたが、とりあえず今回はコピー動作にしてみました。

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

(ifの前でM-x Save Form With Envすると、

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

がコピーされるので、適宜貼り付けることが可能です。
こんな感じの手作りインライン展開をする時などに便利なのではないでしょうか(便利か?)

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

まとめ

今回は、letに抜き出しましたが、defunの式をlambdaに抜き出したりしても良さそうですね。


HTML generated by 3bmd in LispWorks 7.0.0

fletで再帰

Posted 2021-05-23 14:49:07 GMT

こちらの記事を読んで、そういえばSchemeのプログラムをCommon Lispに移植する際などのLisp1→Lisp2変換で似たようなことが必要になるなと思ったので、自分が良く使う方法をまとめてみます。

まず、fletは少し特殊なスコープを持つ構文で、defunlabelsと違って、同じ階層のローカル関数を呼び出すことができません。

(flet ((fib (n)
         (if (< n 2)
             n
             (+ (fib (1- n))
                (fib (- n 2))))))
  (fib 20))
>>>Error: Undefined operator fib in form (fib (1- n)).

(flet ((fib (n) n)) (flet ((fib (n) (if (< n 2) n (+ (fib (1- n)) (fib (- n 2)))))) (fib 20))) → 37

ただ、同じ階層のローカル関数がスコープにないだけなので、ローカル変数として自分自身与えれば再帰できます。

(flet ((fib (n fib)
         (if (< n 2)
             n
             (+ (funcall fib (1- n) fib)
                (funcall fib (- n 2) fib)))))
  (fib 20 #'fib))
→ 6765

Schemeのletrec等の実装方法での常套句のように変数を代入してやる方法もあります。

(let ((fib #'identity))
  (flet ((fib (n)
           (if (< n 2)
               n
               (+ (funcall fib (1- n))
                  (funcall fib (- n 2))))))
    (setq fib #'fib)
    (fib 20)))
→ 6765

この手法はCommon Lispでも古典的なようで、Spice Lisp(1980年初頭)のコンパイラでのlabelsの実装(式変形)もこんな感じみたいです。

  • Spice Lisp: CLC.SLISP

(def-cg labels cg-labels (x &body body)
  (let ((*fenv* *fenv*))
    (do ((defs x (cdr defs))
     (new-env *fenv*)
     (let-list nil)
     (setq-list nil)
     (name (new-internal-variable) (new-internal-variable)))
    ((atom defs)
     (setq *fenv* new-env)
     ;; With new *FENV* bindings in effect, compile the functions,
     ;; then the body.
     (cg-form
      `(let ,let-list (setq ,@setq-list) (progn ,@body))
      for-value))
      (push name let-list)
      (push `#'(lambda ,@(cdar defs)) setq-list)
      (push name setq-list)
      (push (cons (caar defs) name) new-env))))

これは、

(labels ((fib (n)
           (if (< n 2)
               n
               (+ (fib (1- n))
                  (fib (- n 2))))))
  (fib 20))

のような式を、大体下記のように変形します。

(let (.fib.)
  (flet ((fib (n) (funcall .fib. n)))
    (setq .fib. #'(lambda (n)
                    (if (< n 2)
                        n
                        (+ (fib (1- n))
                           (fib (- n 2))))))
    (fib 20)))
→ 6765

Common Lispではどういう時に使うか

多分あまり使わないと思いますが、Schemeのletrec系の構文を実装する際などには、Lisp1→Lisp2の変換が必要になるので、大体似たようなものを作ることになると思います。

(letrec ((fib (lambda (n)
                (if (< n 2)
                    n
                    (+ (fib (1- n))
                       (fib (- n 2)))))))
  (fib 20))
→ 6765


HTML generated by 3bmd in LispWorks 7.0.0

(declare (ignore initargs) (dynamic-extent initargs)) って意味あるの

Posted 2021-05-20 16:53:55 GMT

Eclipse Common Lispのソースを眺めていると、

(declare (ignore initargs) (dynamic-extent initargs))

というのが結構出てきます。

これって果して何かしらの効果あるのだろうかと気になります。
そもそもignoreしているので、dynamic-extentもなにもないのですが、何か深い理由がありそうななさそうな。

Eclispse CLでコンパイル結果を確認してみる

とりあえず、Eclispse CLでコンパイル結果が変化したりするのか確認してみます。

(defun foo (arg)
  (declare (ignore arg) (dynamic-extent arg))
  42)

> (disassemble 'foo)

#include <eclipse.h>

clObject clExtraArgs(clProto), clMissingArgs(clProto);

static clObject I_1, I_42;

clObject usrFoo clVdecl(_ap) { clObject arg; { clBeginParse(_ap); clSetq(arg, (_clVp(_ap) ? clVpop(_ap) : clMissingArgs(I_1, clEOA))); if (_clVp(_ap)) clExtraArgs(clVargs(_ap), clEOA); clEndParse(_ap); } return(clValues1(I_42)); }

void clLoader __P((void)) { clDbind(clstarPACKAGEstar); clDbind(clstarREADTABLEstar); clDbind(clstarLOAD_TRUENAMEstar); clDbind(clstarLOAD_PATHNAMEstar); clSetq(I_1, clIntFixnum(1)); clSetq(I_42, clIntFixnum(42));

clMakeClosure(0, usrFoo, clNULL_HOOK); clUnwind(4); } NIL

(defun bar (arg) 42)

> (disassemble 'bar)

#include <eclipse.h>

clObject clExtraArgs(clProto), clMissingArgs(clProto);

static clObject I_1, I_42;

clObject usrBar clVdecl(_ap) { clObject arg; { clBeginParse(_ap); clSetq(arg, (_clVp(_ap) ? clVpop(_ap) : clMissingArgs(I_1, clEOA))); if (_clVp(_ap)) clExtraArgs(clVargs(_ap), clEOA); clEndParse(_ap); } return(clValues1(I_42)); }

void clLoader __P((void)) { clDbind(clstarPACKAGEstar); clDbind(clstarREADTABLEstar); clDbind(clstarLOAD_TRUENAMEstar); clDbind(clstarLOAD_PATHNAMEstar); clSetq(I_1, clIntFixnum(1)); clSetq(I_42, clIntFixnum(42));

clMakeClosure(0, usrBar, clNULL_HOOK); clUnwind(4); } NIL

上記foobarで何も変化なしです。

Eclipse CL以外の処理系でもちょっと確認してみましたが、手元の処理系では差が出るものはありませんでした。

推理

色々考えてみましたが、Eclipse CLのコードにはかなりdynamic-extent宣言が多く、何かの雛形から生成されたようなコードも多いので、雛形として(declare (dynamic-extent initarg))が付いているところに、追加で、(declare (ignore initarg))がさらに機械的に付加されたのかもしれません。

(declare (ignore arg) (dynamic-extent arg))で何か面白い応用ができないか色々考えてみましたが、特に思い付かず……。
何か面白い応用があれば是非教えてください。


HTML generated by 3bmd in LispWorks 7.0.0

無効化するとunreachableを出すassert

Posted 2021-05-17 18:44:42 GMT

コンパイラへの指示で、assertを無効にした時に消えてしまうのではなくて、unreachableに変化すると最適化のヒントになって良いのではないか、というのを目にしたので、Common Lispで似たようなことができないか試してみます。

Common Lispでは、assertは継続エラーを出すという仕様なので最適化で消えたりはしませんが、ブロックから早期脱出するようにすれば、後続のコードが不達になって不達コードの警告を出すコンパイラもあると思います(SBCL等)

(ql:quickload 'policy-cond)

(defun innermost-block (env) (let ((blk (car #+sbcl (sb-c::lexenv-blocks env) #+lispworks (compiler::environment-benv env)))) (values (car blk) (cdr blk)))))

(defmacro assert* (test-form &environment env) (multiple-value-bind (name namep) (innermost-block env) (if (or name namep) `(policy-cond:policy-if (eql 0 cl:safety) (unless ,test-form (return-from ,name nil)) (assert ,test-form)) `(assert ,test-form))))

policy-condを利用してsafety 0の時だけassertが早期脱出のコードに変換されるようにしてみました。

(defun bar (n)
  (declare ((integer 0 2) n))
  (declare (optimize (safety 0)))
  (assert* (= 3 n))
  (list n))

(bar 1) → nil

LispWorksあたりだと、早期脱出のコードに変換される程度ですが、SBCLでは不達コードの警告を出したりはできるようです。
とはいえ、残念ながらコンパイル時に判明している値レベルでしか判定できませんが。

(defun bar (n)
  (assert* (= 3 4))
  (print n))

; processing (DEFUN BAR ...) ; file: /tmp/slimert9DD9 ; in: DEFUN BAR ; (PRINT N) ; ==> ; N ; ; note: deleting unreachable code ; ; compilation unit finished ; printed 1 note

まとめ

SBCLを始めとするPythonコンパイラ系では、型情報の伝搬や、不達コードの検出等の機能はそこそこありますが、一度どの程度のことをやってくれるのかまとめてみたいところです。

関連


HTML generated by 3bmd in LispWorks 7.0.0

M式の魅力の無さについて

Posted 2021-05-14 01:29:23 GMT

LispといえばS式ですが、S式について語られる際には大抵はM式も一緒に話題にのぼります。
M式は実際の所、正式な仕様は存在しないので処理系製作者が独自に拡張したものをM式としていたことが多いようですが、今回は、そんなM式の魅力の無さについて考えてみましょう。

魅力の無さ その1: 別に中置記法ではない

前置記法のS式を比較対象とするからか、M式は中置記法といわれますが、中置の文法ではっきり決まっていそうなのは関数定義のdefineの=/位と、conldで使われる位で、あとは前置ですし、ユーザー定義の関数は前置です。
後のプログラミング言語のようにユーザーが中置の文法を定義し結合度を定義する、という機構もありません。

M式の構文自体は、当時のFORTRAN I的に書けたら良いのではないか、という程度の構想だったようですが、FORTRAN Iの構文自体がそれ程洗練されたものでもありません。

結局のところ関数名が括弧の外に出ているだけ、という感じです。

fib[n] = [greaterp[2; n] → n;
          T → plus[fib[difference[n; 1]];
                    fib[difference[n; 2]]]]

なお、本格的なプログラミング構文としては、LISP 2でのALGOL構文の採用がありますが、LISP 2は構文としてはALGOLそのものなので中置構文のリッチさに関してはLISP 2が勝るでしょう。

LISP 2

integer function fib(n); integer n;
  if n < 2 
  then n 
  else fib(n - 1) + fib(n - 2);
end;

1960年代当時の次世代LISPであるLISP 2でのALGOL構文の採用が、M式をさらに中途半端な存在にした可能性もなくはないかなと思います。

なお、1960年代に実装されたM式系の構文としては、SDS 930 LISP(1965)のM-languageや中西先生のKLISPがあります。
中西先生の文献にはM言語というのが良く出てきますが、SDS 930 LISP由来なのかもしれません。

SDS 930 LISP

fib [n] : [2 > n # n; 
          T # (fib (n - 1)) + (fib (n - 2))]

ちなみに蛇足ですが、S式はリストで式を表現しているだけなので、リストで中置記法を表現することは可能です。

((fib n) = ((2 > n) → n
            T → ((fib(n - 1)) + (fib(n - 2)))))

魅力の無さ その2: 括弧の数は少ししか減っていない

括弧は外側を囲むことによってグループ化しますが、括弧を減らす記法として、結合する記号を定義して前後を結合する中置記法や、インデントの深さによってグループ化するオフサイドルールや、引数の数を元に括弧を省略する本来のポーランド記法がありますが、上述のようにM式には極僅かしか中置構文が定義されていないので括弧の数は大してかわりません。

数学記号を中置演算子として用意すれば、括弧を減らすことは可能ですが、上述のようにユーザー定義部分は大して変化なしです。

fib[n] = [[2 > n] → n;
          T → fib[n - 1] + fib[n -  2]]]

魅力の無さ その3: 構文の括弧に[]を使っている

LISPの極初期では、構文は()とデリミタの,組み合わせで記述されていたようですが、LISP 1.5の頃には[];の組み合わせになってしまいました。

fib(n) = (greaterp(2, n) → n,
          T → plus(fib(difference(n, 1)),
                    fib(difference(n, 2))))

fib[n] = [greaterp[2; n] → n; T → plus[fib[difference[n; 1]]; fib[difference[n; 2]]]]

(),は、M式内のS式(リスト)の記法に使われることになったようですが、プログラムの記述の方をゴツくしてしまった理由は謎です。

魅力の無さ その4: 構文の記法とデータの記法が未分化

λの仮引数の後に;が必要だったりで構文というよりデータという感じがしてしまいます。
結局M式のこういう中途半端なところがS式へ吸収される原因だったのではないでしょうか。

fib = λ[[n]; 
         [greaterp[2; n] → n
          T → plus[fib[difference[n; 1]];
                    fib[difference[n; 2]]]]]

魅力の無さ その5: データの記法とプログラム構文の記法を覚えないといけない

データからプログラムを作るLispならではの問題ですが、記法が2つあるとどういうルールでどう変換するのか、を覚える必要があります。
この辺りの課題は、M式、ALGOL構文のLISP 2、Dylan、最近だとJuliaにもありますが、プログラム構文としてリッチであれば、データへ変換する際のルールも多くなり直感的でなくなるでしょうし、貧弱であれば、S式で良いじゃんということになってしまいます。

まとめ

結局S式でいいですね。

関連


HTML generated by 3bmd in LispWorks 7.0.0

番号付き括弧

Posted 2021-05-12 01:47:37 GMT

PDP-11上のLISP処理系であるLISP-11のマニュアルを眺めていたところ、括弧の下の行に番号を付与している記述がありました。
1960年代初頭のパンチカード時代に良く利用されていたようですが、編集時の括弧のずれでエラーになった場合に不整合を素早く検知できたりするかもしれないので、そういうエディタコマンドを作成してみます。

(ql:quickload "split-sequence")

(defun numbered-parens (str) (with-output-to-string (out) (let ((pc 0)) (format out "~&~{~A~^~%~}" (mapcan (flet ((subchar (pc) (character (princ-to-string (mod pc 10))))) (lambda (line) (list line (map-into (make-string (length line)) (lambda (c) (case c (#\( (prog1 (subchar pc) (incf pc))) (#\) (prog2 (decf pc) (subchar pc))) (otherwise #\Space))) line)))) (split-sequence:split-sequence #\Newline str))))))

#+LispWorks (progn (editor:defcommand "Numbered Parens" (p) "" "" (declare (ignore p)) (editor::with-random-typeout-to-window () (editor::with-defun-start-end-points (beg end) (editor:current-point) (write-string (numbered-parens (editor::points-to-string beg end))))))

(editor:bind-key "Numbered Parens" "Control-N"))

括弧のエスケープの処理をきちんと処理するのは手間なので実装していませんが、こんな感じに表示します。

(defun numbered-parens (str)
0                      1   1
  (with-output-to-string (out)
  1                      2   2
    (let ((pc 0))
    2    34    43
      (format out
      3        
              "~&~{~A~^~%~}"

(mapcan (flet ((subchar (pc) 4 5 67 8 8 (character (princ-to-string (mod pc 10))))) 8 9 0 09876 (lambda (line) 6 7 7 (list line 7 (map-into (make-string (length line)) 8 9 0 09 (lambda (c) 9 0 0 (case c 0 (#\( (prog1 (subchar pc) (incf pc))) 1 2 3 4 4 4 432 (#\) (prog2 (decf pc) (subchar pc))) 2 2 2 3 3 3 321 (otherwise #\Space))) 1 109 line)))) 8765 (split-sequence:split-sequence #\Newline str)))))) 5 543210

まとめ

近頃だと括弧を虹色に分別して表示する機能があり、LispWorksにも標準で実装されていたりしますが、60年前のrainbow modeというところですね。
個人的には色分けされても括弧対応が判然としないのですが、数字付きだとさすがにはっきりします。
さて、果してデバッグで役に立つかどうか、しばらく使ってみます。


HTML generated by 3bmd in LispWorks 7.0.0

Common Lispでsingle-floatを返す関数をdouble-float返すようにする設定はあるか

Posted 2021-05-09 23:17:53 GMT

Common Lispでsingle-floatを返す関数をdouble-float返すようにする設定はあるか

Common Lispの標準状態の浮動小数点の精度は、単精度(single-float)です。
最近のプログラミング言語の標準の精度は倍精度(double-float)だったりするので、言語間を跨ぐと若干面倒だったりするのですが、標準で倍精度にする設定はないのでしょうか。

# Python
import cmath
cmath.sqrt(-1/3)
→ 0.5773502691896257j

;; Common Lisp
(sqrt -1/3)
→ #C(0.0 0.57735026)

結論:そういう設定はない

結論からいうと、そういう設定はありません。

*read-default-float-format*double-floatにすると良いという話は良く耳にしますが、浮動小数点数の読み取りのデフォルトを設定するのみなので、整数等の読み取りには影響なしです。

(setq *read-default-float-format* 'double-float)
→ double-float

(sqrt -1/3) → #C(0.0F0 0.57735026F0)

(expt 1 1/2) → 1.0F0

上記のような場合、入力側で整数等を浮動小数点数に変換してやることになります。

(sqrt (float -1/3 0d0))
→ #C(0.0D0 0.5773502691896257D0)

(expt 1 (float 1/2 0d0)) → 1.0D0

まとめ

結局のところユーティリティパッケージを作成するしかないようですが、そういうパッケージを見掛けない気がするので需要はないのかもしれません。

作成するとしたら、Common Lispの標準関数で該当するものをdouble-float:sqrtのようにまとめることになりそうです。


HTML generated by 3bmd in LispWorks 7.0.0

HAKMEM: ITEM 59 (Schroeppel)

Posted 2021-05-07 23:52:11 GMT

このブログのためのネタ帳をひっくり返して眺めてみると5年位放置しているネタで、HAKMEM: ITEM 59 (Schroeppel)というメモがありました。

HAKMEMはMIT AIラボの人達のメモ集ですが、割合に雑多なメモです。
HAKMEM ITEM 59は、数字の関係だけが記述されていて、メモを残した理由も記述されていません。

                                               2
91038 90995 89338 00226 07743 74008 17871 09376  =

82880 83126 51085 58711 66119 71699 91017 17324 91038 90995 89338 00226 07743 74008 17871 09376

とりあえず、

  • 2乗した場合に桁数が倍
  • 下半分に自分自身が含まれる

ような数を探してみろということなのかなと思い、例題の40桁の倍の80桁のものを探してみることにします。

(defun fig (x)
  (length (princ-to-string x)))

(defun test-it (x) (multiple-value-bind (q r) (floor (expt x 2) (expt 10 (fig x))) (= x r)))

(defun pp (x &optional (out *standard-output*)) (let ((xx (format nil "~,,' ,5:D" x))) (format out "~%~VD~%~A =~2%~{~V,,' ,5:D~%~}" (1+ (length xx)) 2 xx (multiple-value-bind (q r) (floor (expt x 2) (expt 10 (fig x))) (list (length xx) q (length xx) r)))))

(defun compose-num (x base) (parse-integer (format nil "~D~D" x base)))

(defun decompose-num (x) (maplist (lambda (ns) (parse-integer (coerce ns 'string))) (coerce (princ-to-string x) 'list)))

(defun hakmem59 (n &optional (limit 80)) ;;雑な生成 (loop (when (>= (fig n) limit) (return)) (dotimes (x 1001) ;雑な連続する0への対策 (let ((xn (compose-num x n))) (when (test-it xn) (setq n xn))))) ;;limit桁に切り詰め (setq n (rem n (expt 10 limit))) ;;表示 (dolist (x (reverse (decompose-num n))) (when (= (fig (expt x 2)) (* 2 (fig x))) (pp x))))

2乗した場合に、下一桁に自身の数字が出現する数は、0、1、5、6ですが、下半分の桁に自分自身が現われるとなると、5、6しかありません。
ということで、5か6から出発して一桁ずつ数を当て嵌めて探していけば、簡単にみつかります。

(hakmem59 6 80)
...
 ...
                                                                                               2
61490 10993 78334 90419 13618 89994 42576 57676 91038 90995 89338 00226 07743 74008 17871 09376  =

37810 33620 16684 89789 77935 64658 06599 50861 58235 23230 14798 96610 06702 69587 17457 60530 61490 10993 78334 90419 13618 89994 42576 57676 91038 90995 89338 00226 07743 74008 17871 09376

(hakmem59 5 80) ... ... 2 38509 89006 21665 09580 86381 10005 57423 42323 08961 09004 10661 99773 92256 25991 82128 90625 =

14830 11632 60015 08951 50697 84669 21446 35507 76157 41238 36122 96157 91215 21570 81715 41779 38509 89006 21665 09580 86381 10005 57423 42323 08961 09004 10661 99773 92256 25991 82128 90625

まとめ

以上、雑な探索をしてみましたが、多分探索しなくても一発でみつかる式があったりするんでしょうね。


HTML generated by 3bmd in LispWorks 7.0.0

構文チェッカーとしてのコンパイラマクロ

Posted 2021-05-06 02:32:02 GMT

コンパイラマクロがコンパイル時に展開されることを利用して、非推奨APIの警告を出すというアイデアがあったりしますが、スタイルチェッカー的なものを動かすタイミングとしては丁度良く、また、コンパイラマクロは意味論を変えないことが前提なので親和性も高いと思います。

ということで、コンパイラマクロが構文チェッカーとして使えないか考えてみたいと思います。

定義

まず、letの別名のmyというものを定義します。

(defmacro my ((&rest binds) &body body)
  `(let (,@binds) ,@body))

これに対し、

  • 変数名の重複はエラー
  • 変数束縛部では(変数 値)という形式を強制

というのをコンパイラマクロで追加してみます。

(define-compiler-macro my (&whole whole (&rest binds) &body body)
  (declare (ignore body))
  (dolist (b binds)
    (check-type b (cons symbol (cons T null))))
  (assert (subsetp binds (remove-duplicates binds :key #'car :from-end T))
          nil
         "Variable name duplicated in bind spec: ~S"
         binds)
  whole)

試してみる

束縛部の形式チェック

(defun foo ()
  (my ((x 3) y)
    (list x y)))
;⏏ Error: The value y of b inside (define-compiler-macro my) is not of type (cons symbol (cons t null)).

束縛部の変数重複チェック

(defun foo ()
  (my ((x 3) (x 4))
    (list x)))
;⏏ Error: Variable name duplicated in bind spec: ((x 3) (x 9)).

まとめ

チェッカーの使い勝手的には元のコードはいじらずに後からチェッカーを追加したりしたいところですが、define-compiler-macro定義は一つだけなので、元のコードをいじらないわけにはいきません。

compiler-macro-function関数をラップするようなインターフェイスを作成して、adviceの真似事をしてみれば可能な気もします。

何にしろコンパイラマクロを定義する場所は一つしかないので、複数のフックが共存できるような仕組みが必要ですね。

関連


HTML generated by 3bmd in LispWorks 7.0.0

Common Lispのテスト述語を宣言で指定する試み

Posted 2021-05-03 03:24:49 GMT

Common Lispのシークエンス関数のテスト述語はデフォルトでeqlですが、文字列の比較が多い最近では、equalがデフォルトの方が使い勝手が良い気がします。

最近のSBCLだとequalを指定しても最適化でeqleqにしたりするようですが、それと似た雰囲気でデフォルトをequalにし、declareでテスト述語の指定をすることにしたらどうかと思い試してみました。

下準備

declarationdefine-declarationでユーザー宣言のtestを宣言します。
testは、(declare (test #'eql))のように使います。

(defpackage "b85d852d-3639-5467-af00-962feb136730"
  (:use common-lisp)
  (:import-from
   #+lispworks harlequin-common-lisp
   #+sbcl sb-cltl2
   declaration-information
   define-declaration)
  (:shadow find))

(in-package "b85d852d-3639-5467-af00-962feb136730")

(declaim (declaration test))

(define-declaration test (dcl env) (declare (ignore env)) (values :declare dcl))

コンパイラマクロでの最適化

デフォルトはゆるくequalで、宣言でより判定が狭いeqleqを指定した場合に、それが使われるようにします。

(defun find (item sequence &key (test #'equal))
  (cl:find item sequence :test test))

(define-compiler-macro find (&whole w item sequence &key (test #'equal) &environment env) `(cl:find ,item ,sequence :test ,(or (car (declaration-information 'test env)) test)))

確認

(defun find-foo  (x)
  (find x '("foo" "bar" "baz")))

(find-foo "foo") → "foo"

(defun find-foo-dcl-eql (x) (declare (test #'eql)) (find x '("foo" "bar" "baz")))

(find-foo-dcl-eql "foo") → nil

(flet ((sequal (x y) (string-equal x y))) (defun find-foo-dcl-string-equal (x) (declare (test #'sequal)) (find x '("foo" "bar" "baz"))))

(find-foo-dcl-string-equal 'foo) → "foo"

まとめ

最適化の筋書だと、意味論は変えずに効率だけ良くなるような記述体系になる必要がありますが、今回の例だと、任意の述語を指定できるので、意味論が変ってしまうような指定もできてしまいます。

また、define-declarationdeclaimのようなコンパイル単位ローカルなトップレベルの宣言ができれば、ファイルごとに述語のデフォルトを指定できたりして便利なのですが、どうもSBCLもLispWorksもトップレベルの宣言が定義できない様子。
define-declarationは標準機能ではないため、そういう仕様なのか単に実装の都合なのかは微妙ですが、ちょっと不思議。


HTML generated by 3bmd in LispWorks 7.0.0

Emacs Lispのネイティブコンパイラ vs Common Lisp

Posted 2021-04-28 22:14:11 GMT

今日はSNSでEmacs Lispのネイティブコンパイラがメインラインに来たという話題で賑っていたので、早速GNU Emacsを--with-native-compでビルドして、Common Lispのネイテイブコンパイラと比較してどんなものなのか眺めてみました。
眺めるといっても、お馴染のfibのマイクロベンチを走らせるだけですが。

Emacs Lisp で実行形態三種の比較

まず、Emacs Lispで、通常の定義、バイトコンパイル、ネイティブコンパイルで比較してみます。
いまひとつ作法が分かっていないのですが、定義形式を合せるために、(setf symbol-function)しています。
一応defunでの定義をファイルに書き出してからファイルをコンパイルする手順でも確認してみましたが、結果はほぼ同じようです。

最適化設定が良く分からないのですが、

(setq comp-speed 3)

するとCommon Lispでいう、(declaim (optimize speed 3))的なことになるようなので、以下はこの設定の元で実験しています。

(setf (symbol-function 'fib)
      (lambda (n)
        (if (< n 2)
            n
          (+ (fib (1- n))
             (fib (- n 2))))))

(benchmark-call (lambda () (fib 30)) 1)(0.540617072 0 0.0) (benchmark-call (lambda () (fib 40)) 1)(79.139097209 0 0.0)

(setf (symbol-function 'fib-bc)
      (byte-compile
       (lambda (n)
         (if (< n 2)
             n
           (+ (fib-bc (1- n))
              (fib-bc (- n 2)))))))

(benchmark-call (lambda () (fib-bc 30)) 1)(0.346994376 0 0.0) (benchmark-call (lambda () (fib-bc 40)) 1)(40.036792254 0 0.0)

(setf (symbol-function 'fib-nc)
      (native-compile
       (lambda (n)
         (if (< n 2)
             n
           (+ (fib-nc (1- n))
              (fib-nc (- n 2)))))))

(benchmark-call (lambda () (fib-nc 30)) 1)(0.253148658 0 0.0) (benchmark-call (lambda () (fib-nc 40)) 1)(29.594145706 0 0.0)

大体のところですが、

elisp: (fib 40) Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz
interp 79sec
byte-comp 40sec
native-comp 29sec

という結果でした。

Common Lispとの比較

大体のタイムは分かったので、似たようなスピードのCommon Lisp処理系ということだとCLISPあたりか、ということで、CLISPで関数をコンパイルした場合と、Emacs Lispのネイティブコンパイルのfibの結果を比較してみたところ、両者の結果は、ほぼ同じになりました。
なお、CLISPはネイティブコンパイラではなくバイトコンパイラの処理系です。

(setf (symbol-function 'fib)
      (lambda (n)
        (if (< n 2)
            n
            (+ (fib (1- n))
               (fib (- n 2))))))

(time (fib 30)) Real time: 0.248056 sec. Run time: 0.25 sec. Space: 0 Bytes → 832040

(time (fib 40)) Real time: 30.663303 sec. Run time: 30.59 sec. Space: 0 Bytes → 102334155

CLISP: (fib 40) Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz
interp 116sec
byte-comp 30sec

Common Lispのネイティブコンパイラとの比較

Common Lispのメジャーな処理系は大体ネイティブコンパイラですが、LispWorksで最適化設定なしの場合は、こんな感じです。

(setf (symbol-function 'fib)
      (lambda (n) 
        (if (< n 2)
            n
            (+ (fib (1- n))
               (fib (- n 2))))))

(compile 'fib) Timing the evaluation of (fib 40)

User time = 1.350 System time = 0.010 Elapsed time = 1.293 Allocation = 269016 bytes 0 Page faults → 102334155

LispWorks: (fib 40) Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz
interp 186sec
native-comp 1.35sec

Emacs Lispのネイティブコンパイルfibと比べると大体22倍程度の速さです。
ちなみにLispWorksのインタプリタ実行はかなり遅いことがわかりますが、Common Lisp仕様がコンパイル指向なので、インタプリタはおまけだったり、サポートしていなかったりの処理系が殆どです。

なお、SBCLやLispWorksで型宣言や再帰的なインライン展開を実施して最速を狙うと、ネイティブコンパイルのEmacs Lispの約95倍程度の速度が出ます。
関数呼出しの速度を計測するためのfibのようなマイクロベンチでインライン展開するのは卑怯な気もするのですが、gcc等も展開してくるので、gccに合せるならアリかなと思います。

(defun fib (n)
  (declare (optimize (speed 3) (safety 0) (debug 0) (compilation-speed 0))
           (fixnum n))
  (labels ((fib (n)
             (declare (fixnum n))
             (the fixnum
                  (if (< n 2)
                      n
                      (+ (fib (1- n))
                         (fib (- n 2))))))) 
    (declare (inline fib))
    (fib n)))

CL-USER> (time (fib 40)) Evaluation took: 0.322 seconds of real time 0.320000 seconds of total run time (0.320000 user, 0.000000 system) 99.38% CPU 1,061,775,900 processor cycles 0 bytes consed

まとめ

いまのところEmacs Lispの最適化の作法があまり確立していないようなのですが、Common Lisp風に人が指示する手段もそこそこ用意されているようです。
ただ、まだ発展途上のようでCommon Lispの感覚でコンパイラに最適化のヒント与えようとしても上手く行かない様子。
例えば、comp-hint-fixnumは、(the fixnum ...)な雰囲気のもののようですが、(optimize (speed 3))で使うと現状では却って遅くなったりします。

また、Common Lispではdisassembleで結果を確認しつつ追い込んでいくのが普通ですが、Common Lispのネイティブコンパイラのディスアセンブルの結果と違ってCのコンパイラの世界と行き来している感があります。

Emacs Lispが今後Common Lispのように人力チューニングを中心に展開していくのか、JITを中心にしていくのかは分かりませんが、Common Lisp風なシステムを目指すのであれば、もう少し道具が充実する必要がありそうです。

今回のfibdisassembleの結果は下記のようになります。
なお、現状、AT&T表記決め打ちのようなのですが、disassemble-internalの中でobjdumpを呼んでいるだけのようなので、ここをいじれば好きな表記に変更できるようです。

disassemble-internal:
...
(call-process "objdump" nil (current-buffer) t "-S" "-M" "intel"
                            (native-comp-unit-file (subr-native-comp-unit obj)))
...

0000000000001290 <F6669622d6e63_fib_nc_0>:
    1290:   41 54                   push   r12
    1292:   55                      push   rbp
    1293:   53                      push   rbx
    1294:   48 83 ec 50             sub    rsp,0x50
    1298:   4c 8b 25 49 2d 00 00    mov    r12,QWORD PTR [rip+0x2d49]        # 3fe8 <freloc_link_table@@Base-0x5f8>
    129f:   48 8b 2d 3a 2d 00 00    mov    rbp,QWORD PTR [rip+0x2d3a]        # 3fe0 <d_reloc@@Base-0x580>
    12a6:   49 8b 1c 24             mov    rbx,QWORD PTR [r12]
    12aa:   48 8b 7d 00             mov    rdi,QWORD PTR [rbp+0x0]
    12ae:   ff 93 a8 26 00 00       call   QWORD PTR [rbx+0x26a8]
    12b4:   bf 02 00 00 00          mov    edi,0x2
    12b9:   48 89 e6                mov    rsi,rsp
    12bc:   48 c7 44 24 08 0a 00    mov    QWORD PTR [rsp+0x8],0xa
    12c3:   00 00 
    12c5:   48 89 04 24             mov    QWORD PTR [rsp],rax
    12c9:   ff 93 28 26 00 00       call   QWORD PTR [rbx+0x2628]
    12cf:   48 8b 7d 00             mov    rdi,QWORD PTR [rbp+0x0]
    12d3:   48 85 c0                test   rax,rax
    12d6:   74 18                   je     12f0 <F6669622d6e63_fib_nc_0+0x60>
    12d8:   ff 93 a8 26 00 00       call   QWORD PTR [rbx+0x26a8]
    12de:   48 83 c4 50             add    rsp,0x50
    12e2:   5b                      pop    rbx
    12e3:   5d                      pop    rbp
    12e4:   41 5c                   pop    r12
    12e6:   c3                      ret    
    12e7:   66 0f 1f 84 00 00 00    nop    WORD PTR [rax+rax*1+0x0]
    12ee:   00 00 
    12f0:   ff 93 a8 26 00 00       call   QWORD PTR [rbx+0x26a8]
    12f6:   48 89 c7                mov    rdi,rax
    12f9:   8d 40 fe                lea    eax,[rax-0x2]
    12fc:   a8 03                   test   al,0x3
    12fe:   75 20                   jne    1320 <F6669622d6e63_fib_nc_0+0x90>
    1300:   48 ba 00 00 00 00 00    movabs rdx,0xe000000000000000
    1307:   00 00 e0 
    130a:   48 89 f8                mov    rax,rdi
    130d:   48 c1 f8 02             sar    rax,0x2
    1311:   48 39 d0                cmp    rax,rdx
    1314:   74 0a                   je     1320 <F6669622d6e63_fib_nc_0+0x90>
    1316:   48 8d 04 85 fe ff ff    lea    rax,[rax*4-0x2]
    131d:   ff 
    131e:   eb 0a                   jmp    132a <F6669622d6e63_fib_nc_0+0x9a>
    1320:   49 8b 04 24             mov    rax,QWORD PTR [r12]
    1324:   ff 90 90 25 00 00       call   QWORD PTR [rax+0x2590]
    132a:   48 8b 55 18             mov    rdx,QWORD PTR [rbp+0x18]
    132e:   48 8d 74 24 10          lea    rsi,[rsp+0x10]
    1333:   48 89 44 24 18          mov    QWORD PTR [rsp+0x18],rax
    1338:   bf 02 00 00 00          mov    edi,0x2
    133d:   48 89 54 24 10          mov    QWORD PTR [rsp+0x10],rdx
    1342:   ff 93 e0 1a 00 00       call   QWORD PTR [rbx+0x1ae0]
    1348:   48 8b 7d 00             mov    rdi,QWORD PTR [rbp+0x0]
    134c:   49 89 c4                mov    r12,rax
    134f:   ff 93 a8 26 00 00       call   QWORD PTR [rbx+0x26a8]
    1355:   48 8d 74 24 20          lea    rsi,[rsp+0x20]
    135a:   bf 02 00 00 00          mov    edi,0x2
    135f:   48 c7 44 24 28 0a 00    mov    QWORD PTR [rsp+0x28],0xa
    1366:   00 00 
    1368:   48 89 44 24 20          mov    QWORD PTR [rsp+0x20],rax
    136d:   ff 93 f8 25 00 00       call   QWORD PTR [rbx+0x25f8]
    1373:   48 8b 55 18             mov    rdx,QWORD PTR [rbp+0x18]
    1377:   48 8d 74 24 30          lea    rsi,[rsp+0x30]
    137c:   bf 02 00 00 00          mov    edi,0x2
    1381:   48 89 44 24 38          mov    QWORD PTR [rsp+0x38],rax
    1386:   48 89 54 24 30          mov    QWORD PTR [rsp+0x30],rdx
    138b:   ff 93 e0 1a 00 00       call   QWORD PTR [rbx+0x1ae0]
    1391:   66 49 0f 6e c4          movq   xmm0,r12
    1396:   48 8d 74 24 40          lea    rsi,[rsp+0x40]
    139b:   bf 02 00 00 00          mov    edi,0x2
    13a0:   66 48 0f 6e c8          movq   xmm1,rax
    13a5:   66 0f 6c c1             punpcklqdq xmm0,xmm1
    13a9:   0f 29 44 24 40          movaps XMMWORD PTR [rsp+0x40],xmm0
    13ae:   ff 93 00 26 00 00       call   QWORD PTR [rbx+0x2600]
    13b4:   48 83 c4 50             add    rsp,0x50
    13b8:   5b                      pop    rbx
    13b9:   5d                      pop    rbp
    13ba:   41 5c                   pop    r12
    13bc:   c3                      ret    
    13bd:   0f 1f 00                nop    DWORD PTR [rax]


HTML generated by 3bmd in LispWorks 7.0.0

ケーススタイルの変換にリーダーマクロを使う

Posted 2021-04-17 11:20:40 GMT

仕事でjsonデータを扱うのですが、データ形式自体が開発中のため、開発者によってキー名のケーススタイルがぶれるという事態が発生しました。
それはとりあえず統一すれば良いのですが、データのぶれにより既存のアプリがデータを上手く扱えなくなってしまったので、当座でアプリを機能させるためには、キー名を正規化する必要があります。
しかし、既存のコードのキー名の正規化がまためんどくさいので、リテラル表記の部分はリーダーマクロを使って正規化してみることにしました。

(ql:quickload 'kebab)

(set-dispatch-macro-character #\# #\^ (lambda (srm chr arg) (declare (ignore chr arg)) (kebab:to-camel-case (read srm T nil T))))

(st-json:getjso #^"foo_bar_baz" (st-json:jso "fooBarBaz" 42)) → 42 t

まあ、急場しのぎですが、こういう時はリーダーマクロが便利ですね。


HTML generated by 3bmd in LispWorks 7.0.0

PareditをLispWorksのHemlockに移植してみた

Posted 2021-04-12 17:49:42 GMT

どういう切っ掛けで移植を始めたのか思い出せないのですが、Emacs系エディタでお馴染みのLisp編集支援モードのpareditをLispWorksのエディタ(Hemlock)に移植してみました。

最近のparedit(version 25)は3000行近くあるのですが、移植したものは300行程度のversion 1です。
誰かが既に移植していた気もするのですが、どうも見付からない……。

最初はちまちまとHemlockのdefcommand形式に書き直していたのですが、途中でめんどくさくなってedefunというEmacsのinteractiveを含んだdefun形式のマクロを作成してコピペしていきました。

versio 25とversion 1では機能に差がありますが、私個人が欲しかったforward-slurp-sexp系の機能は大体version 1で既に完備されていたようです。

Editor Lispがあったら嬉しいが……

Emacs系エディタではLispで拡張できるのは嬉しいのですが、似ているけれど割合に違うAPI群をそれぞれ持っているので、エディタ間でLispコードを共有するのは難しい状況です。

大別すると

  • GNU Emacs系
  • Hemlock系
  • Zmacs系

とありますが、圧倒的多数派のEmacs Lispベースで構わないのでEditor Lispとして標準化されたりすると嬉しいですね。
まあ、Hemlockも、Zmacsもほぼ絶滅しているので、これらのプラットフォームがEmacs Lispの資産を活用したいということもないか……。


HTML generated by 3bmd in LispWorks 7.0.0

疑似パッケージマーカーに使う記号色々

Posted 2021-04-07 15:18:41 GMT

Common Lispのパッケージ名とシンボル名を区切る:をパッケージマーカーと呼びますが、パッケージシステムの存在しないLisp方言でも擬似的なパッケージ名として接頭辞を付けたりすることがあります。

そんな擬似的なパッケージマーカーを集めてみたり良さそうなパッケージマーカーを考えてみたりしましょう。

package:symbol

:が採用されたのは恐らくLisp Machine Lispが最初ですが、Common Lispに受け継がれました。
Lisp Machine LispとCommon Lispの違う点は、外部に公開するシンボルをpackage:symbolと、一つの:で表現し、二つの場合は、内部シンボルpackage::symbolという風に表現するところと、Common Lispは階層パッケージでない点です。
:の個数の使い分けが案外面倒で、外部に公開するAPIとしてのシンボル名のデザインは結構難しいと感じます。

ちなみに、Common Lisp以外でも、Schemeなどでも区切りとして使われたりしています。

package/symbol

Clojure等が/を使っていますが、他のLispでも疑似パッケージ的に使われることがそこそこある記号かなと思います。

package.symbol

Lisp系ではそんなに使われている感はありませんが、Pythonっぽくもありますし、そこそこ使えそうな気がします。

package-symbol

パッケージが登場する前のLispがこんな感じですが、Emacs Lispの作法ではこのスタイルが推奨されています。
シンボル部に-が良く使われるので、パッケージの区切りかどうかがはっきりしないのが欠点といえば欠点でしょうか。
Common Lispでも、package:subpackage-symbolのような名前は結構使われているかなと思います。

package>symbol

Lispマシン用のCの処理系であるZeta-Cで使われている記法ですが、何故>を使っているのかは良く分かりません。
古えのOSでは>がディレクトリパスの区切りだったりもしたので、/と同じような雰囲気なのかもしれません。

package*symbol

古いLispコードで見掛けたことはありますが、ほぼ見掛けません。
割合に使えそうな気もしますが果して……。

symbol$package

LISP 2で使われていた記法で、LISP 2では正確にはpackageではなくsectionですが、前後が逆なのが特徴です。
大抵は関数名で覚えている気がしますが、パッケージ名が後置だとIDE等での補完が簡単な気もします。

色々考えてみた

package_symbol

Lispでは-の使い勝手の良さから極端に利用頻度が低い_ですが、あまり競合しないので接頭辞の区切りには良いかもしれません

package||symbol
package\Symbol

実質package||symbolpackage\Symbolpackagesymbolは一緒ですが、コードの字面上では区切りが付きます。

<package>subpackage>symbol
<package.subpackage>symbol
[package]symbol

古えのOSのパス区切りを模したものですが、Common Lispではシンボル名に使える文字が多いので結構そのまま書けます。

まとめ

以上、まとまりなく疑似パッケージの区切りを紹介してみたり考えてみたりしました。
個人的に疑似パッケージマーカーが必要になるのは、Schemeのコードで、char-set:alphabetのようなものをCommon Lispにどうにか翻訳するケースが多いですが、これまでは、

  • Common Lispのパッケージとして、char-set:alphabetと翻訳(パッケージ作成がめんどう)
  • char-set.alphabetと翻訳
  • char-set$alphabetと翻訳

等々としてきました。
最近は面倒になってきて、char-set\:alphabetと書くようにもなりましたが、なにか疑似パッケージ記号の決定版みたいなものがあれば、一つの表記に落ち着くのになあと思ったりです。


HTML generated by 3bmd in LispWorks 7.0.0

condのelse節色々

Posted 2021-04-03 23:05:30 GMT

Schemeのcondのelse節はelseを書きますが、古典的なLispでは、condのelse節ではTを書きます。

;; Scheme
(cond (...)
      (else ...))

;; Common Lisp (cond (...) (T ...))

このTは半ば慣用句で真値となるものであれば何でも良いのですが、最近古い文献を眺めていて妙なものをみつけたのでまとめてみます。

1 と書く

(cond (...)
      (1 ...))

LISP 1の頃には、nilが0で、Tが1だったりして、M式にもTの代りに直接1が書いてあったりします。
LISP 1のM式をS式に変換した例などで稀ですが見掛けることがあります。

'T と書く

(cond (...)
      ('T ...))

Tquoteが付いているのですが、何故付いているのかは謎。
LISP 1.5のM式では大文字はクォートされたシンボルを表わすのでM式のTを正確にS式に翻訳すると(quote T)となりますので、この辺りが由来かもしれません。
MACLISPのコードで良く見掛けます。

'else と書く

(cond (...)
      ('else ...))

真値であれば何でも良いので'elseというシンボルをそのまま使ったもの。
たまに古いコードで見掛けます。

稀ですが、

(cond (...)
      (:else ...))

というキーワードシンボルの場合もあり。

(cond (...)
      ("else" ...))

でも良さそうですが、個人的には目にしたことはありません。

(and)

(cond (...)
      ((and) ...))

List Techniques / Harold V. McIntosh(1963)で良く使われている書法ですが、確かに(and)Tに評価されます。
どちらかというとandよりはorな気分な気がしますが、else節を目立たせる場合には使えたりするかもしれません。

(t)

(cond (...)
      ((t) ...))

MBLISPというLisp 1.5系の古いLispのコード例等に出てくる書き方です。
(t)Tを返すような疑似関数になっています。(true)みたいなものですね。

書かない

(cond (...)
      ((progn ...)))

else節の述語部に直接実行する式を書いてしまうというパターンです。
大抵のLisp処理系では述語部から多値を返すことができないので、注意が必要ですが、1970年代あたりでは結構目にするスタイルです。

arcのifのelse節でも良く見掛けますが多値を考慮しなくて良いのと、括弧がネストしていないのが理由かもしれません。ちなみにclosureだと節が偶数でないとエラーになるのでできないようです。

まとめ

他にも微妙なバリエーションがありますが、1990年代以降はt以外のものを書く人は殆どいないようです。


HTML generated by 3bmd in LispWorks 7.0.0

validate-superclassの謎

Posted 2021-03-22 01:47:43 GMT

MOPでメタクラスを定義した場合などに定義が必要になるvalidate-superclassですが、処理系によって定義が必要であったりなかったりするので、実際のところどういう動作が正しいのか改めて確認してみました。

メタクラス定義でvalidate-superclassを定義する意味

メタクラスが違う二つのクラスの間で継承関係が成立するかどうかは分からないのでデフォルトでは継承関係は成立しないとしていて、成立させたい場合は明示する仕組みというのが簡単な説明です。

この「デフォルトでは継承関係は成立しない」というのをvalidate-superclassで表現していて、成立させる場合にはTを返すメソッドを定義します。

(defclass my-class (standard-class)
  ())

(validate-superclass (class-prototype (find-class 'my-class)) (class-prototype (find-class 'standard-class))) → nil

この状態で、my-classをメタクラスとするクラスmy-objectを定義する場合、my-objectはオブジェクトの表現としてstandard-objectを継承して利用するのがデフォルト動作(省略時)なので、

(defclass my-object (standard-object)
  ()
  (:metaclass my-class))

のようなものを書いた場合、

(validate-superclass (class-prototype (find-class 'my-class))
                     (find-class 'standard-object))

のようなチェックが一連のスーパークラスで実施され、全てがTでなければ、エラーとなります。
処理系ごとのvalidate-superclassの動作の違いですが、下記のようになります。

明示的に指定しなければ互換性はないとする処理系

(validate-superclass (class-prototype (find-class 'my-class))
                     (find-class 'standard-object))
→ nil

AMOPに記載の通りの判定ですが、

  • CMUCL
  • SBCL

あたりがそういう挙動で、validate-superclassをちゃんと書いてやる必要があります。

サブメタクラスがstandard-classのサブクラスで、スーパーメタクラスがstandard-classの場合は互換性あり

(validate-superclass (class-prototype (find-class 'my-class))
                     (find-class 'standard-object))
→ T

  • LispWorks
  • CLISP

あたりがこの挙動です。
この挙動であれば、validate-superclassを書かなくて良さそうにも思えますが、メタクラスがstandard-classの別のサブクラス同士だと継承関係がない場合があるので、その場合はvalidate-superclassを書いてやる必要があります。

具体的には、下記のコードのような状況でvalidate-superclassの定義が必要になります。

(defclass my-class/ (standard-class)
  ())

(defclass my-object/ (standard-object) () (:metaclass my-class/))

(validate-superclass (class-prototype (find-class 'my-class/)) (find-class 'my-object)) → nil

(defmethod validate-superclass ((c my-class/) (s my-class)) T)

(validate-superclass (class-prototype (find-class 'my-class/)) (find-class 'my-object)) → T

;; 上記の定義がなければエラー (defclass my-object// (my-object) () (:metaclass my-class/))

サブメタクラス、スーパーメタクラスが共にstandard-classのサブクラスなら互換性あり

あたりがこの挙動です。
メタクラスがstandard-classのサブクラス同士であれば、validate-superclassの定義を書く必要はありません。
これはこれで便利な挙動で、validate-superclassの定義を書くことは殆ど無くなるのは良いのですが、この挙動が災いしてAllegro CLのコードの移植性の無さの一因になっている気がします。

上記のように処理系によってデフォルトの挙動が違いますが、互換性があることを明示するvalidate-superclassのコードがあっても挙動を変えることはないので、AMOP準拠で全部明示しておくのが吉かなと思います。

クラスに互換性がないとはどういうことか

ANSI CL規格では、互いに素である型が定義されていますが、

defclassdefine-conditiondefstructで継承関係を定義した型以外は互いに素であるとしています。
integerconsの間では継承関係を考えようとは思わないのですが、メタクラスをカスタマイズする場合は、メタクラスが異なるのみで他の挙動は継承したいことがほとんどかと思います。

validate-superclass の歴史

validate-superclassは用途が限定されている割には機能としては汎用的なのですが、もともとはcheck-super-metaclass-compatibilityという名前だったようです。
途中で、valid-superclass-p等の名前になったりもしたようですが、1990年頃、validate-superclassで落ち着き現在に至る様子。

check-super-metaclass-compatibilityvalidate-superclassよりも判定が厳しく、デフォルトの挙動は双方のメタクラスがeqの場合のみTとしていたようです。

現在のvalidate-superclasscheck-super-metaclass-compatibilityの目的に使うことが殆どですが、CMUCLやSBCLでは互換性の判定用に組み込みクラスについても非互換性のリストをもっているので、

(validate-superclass (find-class 'null)
                     (find-class 'cons))
→ nil

のように判定します。
他の処理系は、大体のところはstandard-classの範疇の判定しか想定していないようなのでTを返しますが、こんな動作でも問題ない程度には汎用的には使われていないということなのかもしれません……。

まとめ

validate-superclassについて掘り下げてみましたが、validate-superclassは用途が限定的ですし、考えるほどcheck-super-metaclass-compatibilityという名前のままでも良かったのではないかと思えてきます。


HTML generated by 3bmd in LispWorks 7.0.0

1+

Posted 2021-03-18 15:03:34 GMT

Slackなどの絵文字の入力方法に:+1:と入力して、👍を出すというのがありますが、どうしても手が勝手に:1+:と入力してしまうので、諦めて:1+:を絵文字として登録しました。
これで誤入力のイライラから開放されました。Common Lisp病の方にお勧めしたい解決策です。


HTML generated by 3bmd in LispWorks 7.0.0

Common Lispで列挙型はどう書いたら良いの

Posted 2021-01-24 15:41:27 GMT

Common Lispでもたまに列挙型が欲しいことがありますが、そもそも列挙型はある要素の集合のことを指すようで、連続的な整数の一連の別名というわけではない様子。

そういった場合は、型記述子memberで記述できるのですが、

(typep 'a '(member a b c))
→ t 

大抵の場合は、数値の連続に別名が付いたものが欲しかったりするので、memberでは数値との対応が実現できません。

連続した数値に別名を付与しつつ、これらと組み合わせて使うことが多いcase系の構文でも使い勝手良いものをと考えると、シンボルマクロで数値に別名を付与しつつ型の宣言もつけたらどうかと思い試してみました。

具体的には下記のようになります。

(deftype foo () '(eql 0))
(define-symbol-macro foo 0)

(typep foo 'foo) → t

少し規模が大き目なものの場合、

(macrolet ((defenum (&rest args)
             `(progn
                ,@(loop :for idx :from 1
                        :for name :in args
                        :collect `(progn
                                    (define-symbol-macro ,name ,idx)
                                    (deftype ,name () '(eql ,idx)))))))
  (defenum H He Li Be B C N O F Ne Na Mg Al Si P S Cl
           Ar K Ca Sc Ti V Cr Mn Fe Co Ni Cu Zn Ga Ge As Se Br
           Kr Rb Sr Y Zr Nb Mo Tc Ru Rh Pd Ag Cd In Sn Sb Te I
           Xe Cs Ba La Ce Pr Nd Pm Sm Eu Gd Tb Dy Ho Er Tm Yb
           Lu Hf Ta W Re Os Ir Pt Au Hg Tl Pb Bi Po At Rn Fr Ra
           Ac Th Pa U Np Pu Am Cm Bk Cf Es Fm Md No Lr Rf Db Sg
           Bh Hs Mt Ds Rg Cn Nh Fl Mc Lv Ts Og))

(typecase F ((or F Cl Br I At Ts) 'yes) (T 'no)) → yes

(deftype Halogens () (list 'member F Cl Br I At Ts))

(typecase F (Halogens 'yes) (T 'no)) → yes

ちなみに、定数宣言して、case#.の組み合わせを使うというのを目にしたことはありますが、#.を書くのが面倒だったり、評価タイミングを考えたりする必要があったりで、あまり使い勝手は良くないという印象です。

(case .F
  ((#.F #.Cl #.Br #.I #.At #.Ts) 'yes)
  (otherwise 'no))
→ yes 

まとめ

cl-enumerationのようなライブラリもありますが、一般的な言語の所謂enumとは微妙に目指すところが違うようです。

Common Lispだけで完結している場合には、あまり必要にならないのですが、既存のデータ定義を取り込んだり、別言語のコードを流用したりする場合に、enum欲しいなあとなることが多いですね。


HTML generated by 3bmd in LispWorks 7.0.0

マルチパラダイムなCommon Lispには逃げ場が沢山ある

Posted 2021-01-21 01:55:42 GMT

こちらの記事を読んで、自分が考えているオブジェクト指向とは随分違う何かがC++やJavaのオブジェクト指向プログラミングなんだなあと思いましたが、それと同時に、パラダイムがどうこうというより特定のパラダイムやシステムに囚われてしまう状況では、そこから抜け出すには、既存のものを捨てて他のパラダイムに移行せざるを得ないと考えてしまうのかもなあと感じました。

Common Lispはマルチパラダイムですが、

  • 手続き/命令型(gotoもあり)
  • 関数型/適用型/式指向
  • とても動的なオブジェクト指向システム
  • メタプログラミング(eval、マクロetc)

あたりが組込み機能です。

データがコードなため、メタプログラミングが容易で、組み込み言語のDSLで、Prologや、プロダクションシステム等を組込んで使ったりすることも可能です。 まあ、DSLが元言語とどこまで違和感なく連携するかはまた別の話ではありますが。

goto廃止論争が華やかだった時代も、マクロで構文を拡張できるLispは、gotoを廃止するということもなく、goを直接手書きしないような構文をマクロで言語標準機能として構築して迂回。
オブジェクト指向システムはSmalltalkの影響下で二三の実装がありましたが、最終的には総称関数という関数呼び出しにメッセージ送信を融合したような形式に収める、などなど、色々なパラダイムを吸収してきてはいますが、オブジェクト指向システムをほぼ使わずに書くことも可能ですし、関数がファーストクラスなので関数型的に書くことも容易です。
もともと対話環境が強力ですが、対話形式でも使えますし、バッチ形式でも使えます。 様々なパラダイムを強力なメタプログラミング機構がゆるくまとめているところもあるかもしれません。

こういうCommon Lispみたいな逃げ場が沢山ある言語が流行ると嬉しいですね。


HTML generated by 3bmd in LispWorks 7.0.0

Common Lispで大量のスロットがあるclassの初期化手順を自動生成する

Posted 2021-01-11 20:32:42 GMT

こちらの記事を目にして、IDEでコードを自動生成するのって格好良いと思ったので、Common Lispだとどうなるか考えてみました。

とりあえず構造体の場合は何もしなくてもコンストラクタのinitargがスロット名に応じて決定されてしまうので、何もしなくてもOKです。
勝手に決まってしまうことについては賛否がありますが、便利な局面は多いかと思います。

(defstruct codable-struct)

(defstruct (sample-struct (:include codable)) int title body thumbnail-url tags categories created-at updated-at comment favoritedp bookmarkedp url)

(make-sample-struct :int 0 :title "title" :body "body" :thumbnail-url "https://example.com/image.jpg" :tags '("tag") :categories "cat" :created-at 0 :updated-at 0 :comment "comment" :favoritedp nil :bookmarkedp nil :url "https://example.com") → #S(sample-struct :int 0 :title "title" :body "body" :thumbnail-url "https://example.com/image.jpg" :tags ("tag") :categories "cat" :created-at 0 :updated-at 0 :comment "comment" :favoritedp nil :bookmarkedp nil :url "https://example.com")

クラスの場合は、構造体と違って全部指定してやらないといけません。
定義していない初期化のためのキーワード(:initarg)を指定しない場合はもちろんエラーです。

(defclass codable () 
  ())

(defclass sample-class (codable) (int title body thumbnail-url tags categories created-at updated-at comment favoritedp bookmarkedp url))

(make-instance 'sample-class) → #<sample-class 402018AA93>

(make-instance 'sample-class :int 0 :title "title" :body "body" :thumbnail-url "https://example.com/image.jpg" :tags '("tag") :categories "cat" :created-at 0 :updated-at 0 :comment "comment" :favoritedp nil :bookmarkedp nil :url "https://example.com") → #<error>

初期化手続きを生成してみる

Common Lispだとコンストラクタのコードを生成するようなことはマクロで実現してしまうのですが、IDEが補完してくれるのが格好良いという話なので、IDE側でコードを生成して挿入したいところです。

ということで、initialize-instanceのコードを生成して、エディタのコマンドで挿入してみることにしました。

(let* ((keys (mapcar (lambda (s)
                       (let ((s (slot-definition-name s)))
                         `(,s nil ,(intern (format nil "~A?" (string s))))))
                     (class-slots (find-class 'sample-class)))))
  `(defmethod initialize-instance ((obj sample-class) &key ,@keys)
     (let ((obj (call-next-method)))
       ,@(mapcar (lambda (k)
                   (destructuring-bind (name init namep)
                                       k
                     (declare (ignore init))
                     `(and ,namep (setf (slot-value obj ',name) ,name))))
                 keys)
       obj)))

した結果をエディタ(LispWorksのHemlock)からバッファに挿入します。
パッケージとシンボルの扱いのあれこれがあるので大分ごちゃごちゃになりました。

(defcommand "Generate Memberwise Initializer" (p)
     "Generate Memberwise Initializer"
     "Generate Memberwise Initializer"
  (declare (ignore p))
  (let ((def (current-top-level-definition-maybe)))
    (if (and (listp def)
             (eq (first def) 'defclass))
        (progn
          (end-of-defun-command 1)
          (insert-string
           (current-point)
           (with-output-to-string (out)
             (pprint 
              (let ((.class-name. (second def)))
                (declare (special editor::.class-name.))
                (eval
                 (read-from-string 
                  "(let* ((keys (mapcar (lambda (s)
                                       (let ((s (slot-definition-name s)))
                                         `(,s nil ,(intern (format nil \"~A?\" (string s))))))
                                     (class-slots (find-class editor::.class-name.)))))
                  `(defmethod initialize-instance ((obj sample-class) &key ,@keys)
                     (let ((obj (call-next-method)))
                       ,@(mapcar (lambda (k)
                                   (destructuring-bind (name init namep)
                                                       k
                                     (declare (ignore init))
                                     `(and ,namep (setf (slot-value obj ',name) ,name))))
                                 keys)
                       obj)))")))
              out))))
        (message "~S is not a defclass" def))))

これで、defclassの上で、“Generate Memberwise Initializer” します。

(defmethod initialize-instance
  ((obj sample-class)
   &key
   (int nil int?)
   (title nil title?)
   (body nil body?)
   (thumbnail-url nil thumbnail-url?)
   (tags nil tags?)
   (categories nil categories?)
   (created-at nil created-at?)
   (updated-at nil updated-at?)
   (comment nil comment?)
   (favoritedp nil favoritedp?)
   (bookmarkedp nil bookmarkedp?)
   (url nil url?))
  (let ((obj (call-next-method)))
    (and int? (setf (slot-value obj 'int) int))
    (and title? (setf (slot-value obj 'title) title))
    (and body? (setf (slot-value obj 'body) body))
    (and thumbnail-url? (setf (slot-value obj 'thumbnail-url) thumbnail-url))
    (and tags? (setf (slot-value obj 'tags) tags))
    (and categories? (setf (slot-value obj 'categories) categories))
    (and created-at? (setf (slot-value obj 'created-at) created-at))
    (and updated-at? (setf (slot-value obj 'updated-at) updated-at))
    (and comment? (setf (slot-value obj 'comment) comment))
    (and favoritedp? (setf (slot-value obj 'favoritedp) favoritedp))
    (and bookmarkedp? (setf (slot-value obj 'bookmarkedp) bookmarkedp))
    (and url? (setf (slot-value obj 'url) url))
    obj))

defclassで定義した挙動とは厳密には違いますが、こんな感じに初期化できるようになりました。

(make-instance 'sample-class 
               :int 0
               :title "title"
               :body "body"
               :thumbnail-url "https://example.com/image.jpg"
               :tags '("tag")
               :categories "cat"
               :created-at 0
               :updated-at 0
               :comment "comment"
               :favoritedp nil
               :bookmarkedp nil
               :url "https://example.com")
→ #<sample-class 4020240C13>
#||
int                0
title              "title"
body               "body"
thumbnail-url      "https://example.com/image.jpg"
tags               ("tag")
categories         "cat"
created-at         0
updated-at         0
comment            "comment"
favoritedp         nil
bookmarkedp        nil
url                "https://example.com"
||#

スロット定義を生成してみる

初期化手続きの生成はどうもいまひとつな気がするので、スロット定義を自動生成する方法を試してみます。

とりあえず、

  • クラスを定義
  • クラスのスロット定義からスロット名を抜き出し:initargを生成
  • コードを置き換え

としてみます。

クラスのスロット定義からスロット名を抜き出し:initargを生成するのはこのようになります。

(defun add-initargs (class-name)
  (dolist (s (class-direct-slots (find-class class-name)))
    (setf (slot-definition-initargs s)
          (list (intern (string (string (slot-definition-name s)))
                        :keyword))))
  (reinitialize-instance (find-class class-name)))

次にdefclassフォームの生成

(defun gen-defclass (class-name)
  (let ((class (find-class class-name)))
    `(defclass ,(class-name class)
               (,@(mapcar #'class-name (class-direct-superclasses class)))
       ,(mapcar (lambda (s)
                  (append (list (slot-definition-name s))
                          (mapcan (lambda (i)
                                    (list :initarg i))
                                  (slot-definition-initargs s))))
                (class-direct-slots class))
       (:documentation ,(documentation class 'type))
       (:metaclass ,(class-name (class-of class)))
       (:default-initargs ,@(class-default-initargs class)))))

エディタのコマンドにまとめる

(defcommand "Generate Memberwise Initializer" (p)
     "Generate Memberwise Initializer"
     "Generate Memberwise Initializer"
  (declare (ignore p))
  (let ((def (current-top-level-definition-maybe)))
    (if (and (listp def)
             (string-equal (first def) 'defclass))
        (let ((*package* (get-buffer-current-package (current-buffer))))
          (add-initargs (print (second def)))
          (let ((dc (gen-defclass (second def))))
            (end-of-defun-command 1)
            (insert-form-at-point (current-point) 
                                  dc))
          (values))
        (message "~S is not a defclass" def))))

これで、コマンド実行でスロット名がキーワードパッケージになった:initargが追加されたdefclassがバッファに挿入されます。
ちなみに、:initarg以外も処理する必要がありますが今回は面倒なので省略します……。

(defclass sample-class (codable)
  ((int :initarg :int)
   (title :initarg :title)
   (body :initarg :body)
   (thumbnail-url :initarg :thumbnail-url)
   (tags :initarg :tags)
   (categories :initarg :categories)
   (created-at :initarg :created-at)
   (updated-at :initarg :updated-at)
   (comment :initarg :comment)
   (favoritedp :initarg :favoritedp)
   (bookmarkedp :initarg :bookmarkedp)
   (url :initarg :url))
  (:documentation nil)
  (:metaclass standard-class)
  (:default-initargs))

まとめ

色々考えてみましたが、defclassの派生マクロを作る方が楽だなと思いました。

マクロを基準に考えると、IDE側の方は展開したコードから元のコードへ戻す知識が失われるという欠点があり、マクロは派生した構文の使い方をおぼえるのが手間という欠点があります。

プログラム生成の知識をIDEが持つのかマクロが持つのかの違いでしかないと考えれば、プロジェクトごとに派生した定義構文があっても別に良いのかなと思ったりしました。


HTML generated by 3bmd in LispWorks 7.0.0

LispWorks IDEの紹介

Posted 2021-01-09 03:32:39 GMT

LispWorks IDEの紹介

LispWorksの特長

LispWorksを他のCommon Lispの処理系と比較した場合の特徴としては、Lisp処理系とIDEが密に連携している点です。

1989年のHarlequinのLispWorksの紹介によると、言語処理系の設計に先行してIDEの設計をしたとありますが、この辺りがLispWorksがIDE然としてしている所以ではないでしょうか。

LispWorks
=========

...

The Approach

By designing the programming environment before the underlying language system, Harlequin has engineered an unrivalled degree of internal cohesion into the product. Programming tools are firmly embedded in the environment and both are supported by sophisticated facilities for compilation and interpretation, together with unobtrusive ephemeral garbage collection. The whole package is written in Lisp to enhance consistency, maintainability and extensibility.

Lispマシンの環境も単なるLisp処理系ではなくIDEを指向していましたが、その後に擡頭してくる安価なUnixワークステーション上でのCommon Lisp環境もLispマシンを手本とし、IDEとしての完成度を追求していました。
似たような文化の言語にはSmalltalkがありますが、Common Lispの方は、Smalltalkと違って時代が下るにつれ処理系の言語処理系のコア以外の部分がどんどん落ちてしまい、Emacs+Common Lisp処理系(SLIME)というLispマシン以前に近いところまで遡ってしまいました。
その点では、LispWorksはIDEとしてのCommon Lisp環境として生き残った数少ない例かなと思います。
類似のものには、MCLがありましたが、2009年にIDEとしては終焉を迎えています。

LispWorksのIDEで便利な機能をピックアップして紹介

LispWorksのIDEの詳細な解説はマニュアルにゆずるとして、便利な機能をピックアップして紹介してみます。

インスペクタの履歴機能

Tools > Inspectorからインスペクタを開けます。

下記のように*inspect-through-gui* Tの状態でinspectを使うとinspectの実行履歴が、PreviousNextボタンで参照できます。

(setq *inspect-through-gui* T)

(defun foo-loop (n) (dotimes (i n) (inspect (* i 8))))

(foo-loop 8)

オブジェクトの状態変化の追跡等に非常に便利です。

関数呼び出しの一覧

Definitions > Function Calls で呼び出しをツリー構造で眺めることが可能です。
所謂、who-callscalls-whoの機能なのですが、GUIの操作でソースの参照も簡便に実現されているため、ソース参照M-x .およびM-x ,の発展版としても利用可能です。

ステップ実行

GUI画面でステップ実行が可能です。
現在メジャーな開発環境であるSBCL+SLIME等ではステップ実行は苦手としているためか、ステップ実行自体がCommon Lispでは無理という印象がありますが、LispWorksでは普通にGUIから対話的に操作可能です。

ブレイクポイントの設定

Common Lispの関数でいうと(break)ですが、LispWorksでは、IDEとして統合されていて、メニューや、エディタのM-x Toggle Breakpointで該当箇所に印をつけることで、(break)をコードに差し込まなくともブレイクすることが可能です。他の言語のIDEとしてもメジャーな機能かと思います。

ブレイクした後は、IDEのデバッガでリスタートや脱出、値の調査が可能です。

また、インスタンスオブジェクトのスロットのアクセスにもブレイクポイントを仕掛けることが可能です。こちらはインスペクタからブレイクポイントとその種類を設定可能ですがデバッグには便利でしょう。

アウトプットブラウザ

主に印字出力の確認ですが、LispWorksをSLIME的に使うのであれば、エディタ+アウトプットブラウザのウィンドウの二枚開きか、エディタ+リスナーの二枚開きという感じになります。
アウトプットブラウザにはプリントの結果やマクロ展開やtimeの結果が上から下へ流れて表示されます。

コンパイラ警告ブラウザ

コンパイラの警告を一覧でみることができるブラウザです。
エラーメッセージをクリックしてエラー箇所の関数にジャンプし修正、等が可能です。

トレースブラウザ

Common Lispでいう(trace)をGUIから操作できるようにしたものです。
テキスト表示とそれほど違いはありませんが、視認性と操作性は向上しているかと思います。

オブジェクトのクリップボード

テキストのコピペのクリップボード機能のようにオブジェクトをクリップボードに保存し、任意の場所に貼り付けることが可能です。

リスナー上でmake-instanceしたオブジェクトを保存しておき、インスペクタで変化を確認したり、値を設定したりするのに便利です。

ツール間のリンク機能

結果の確認ツールとして、リスナー(REPL)や、インスペクタが活躍しますが、ツール間でリンクすることにより、あるツールの結果をインスペクタやリスナーと同期させることが可能です。

マニュアルに紹介されている例では、クラスブラウザでクラスを眺めつつ、Tools Cloneでクラスブラウザを複製し、主になるクラスブラウザとEdit > Link fromでリンクし、サブの方は同期したスロット定義を眺める、という使い方が紹介されています。

リスナーとの連携は、リスナー上の*変数を仲介した連携が主で、インスペクタとリンクすることにより、リスナーの*変数が更新される度にインスペクタのオブジェクトも更新される、ということが可能です。

ちなみに、エディタともリンク可能ですが、バッファオブジェクトが共有されるため、いまいち使いどころが難しくなっています。もしかしたら、バッファオブジェクト経由でのエディタの一括編集の実行等で活躍できたりするのかもしれません。

統合された定義の取消し機能

def系の構文の上でM-x Undefineコマンドを実行することにより、定義を取り消すことが可能です。
特に便利なのは、defmethodの場合ですが,定義のメソッドだけ削除してくれるところが便利でしょう。
このためLispWorks上では、総称関数をfmakunboundして一式を再定義するようなことは皆無です。

また、定義系の構文がIDEと統合されていて拡張可能なため、任意の定義構文用のUndefine操作をユーザーが設定可能です。

エディタ

エディタはこのブログでも何度か紹介していますが、元は、Spice LispのHemlockというEmacsのCommon Lisp実装です。
この記事もLispWorksのHemlockで書いていますが、Emacsとしてもそこそこ普通に使えます。
ユーザー定義のコマンド等は、当然ながらCommon Lispで拡張を書きますが、LispWorksの機能をフルに活用できるのがメリットでしょうか。

まとめ

ざっと、普段使っていて便利なLispWorks IDEの機能を紹介してみました。
細かい便利機能は沢山あるので、機会があればまた紹介してみたいと思います。


HTML generated by 3bmd in LispWorks 7.0.0

データの検索に組み込みPrologを使ってみる(1)

Posted 2021-01-03 21:49:53 GMT

LispWorksのKnowledgeWorksでは、オブジェクトシステムと組み込みPrologが統合されています。
Prologの複合項(構造体)に相当するものをオブジェクトや構造体で表現しますが、この知識ベースクラスのオブジェクトや構造体はワーキングメモリという場所に蓄積されます。

ワーキングメモリに蓄積されたオブジェクトは、(class名 ?obj スロット名 ?slot ...)という形式でパターンマッチで問い合わせ可能になります。

読み込んだJSONや、plistで表現したデータ、ORMでSQLで問い合わせした結果のオブジェクト等、様々な形式のデータをワーキングメモリに格納し、Prologで問い合わせするのが割合に便利なのですが、今回は、LispWorksではなくPAIPrologのようなものでも似たようなことができないか試してみたいと思います。

ウェブページのスクレイピングを組み込みPrologで

今回は、ウェブページのスクレイピングをPrologの問い合わせでやってみます。
利用する組み込みPrologは、PAIPrologですが、単一化がeqlだったり、オブジェクトを項として登録するのに結局改造しないといけなかったので、実験用にPAIPrologからフォークして別パッケージを作成してみました。

(ql:quickload '(clss plump dexador zrpaiprolog))

(defpackage "d7aba921-29b4-5320-acaa-13531caa1f16" (:use c2cl zrlog) (:shadowing-import-from zrlog ignore debug symbol))

(cl:in-package "d7aba921-29b4-5320-acaa-13531caa1f16")

Prologの項を登録する

今回、DOMオブジェクトにはplumpを利用します。
plump:elementが基本となるオブジェクトなので、plump:elementという名前とオブジェクトを項として登録するadd-object-clauseというものを定義し、オブジェクト生成時のフックに登録します。

(defmethod initialize-instance :after ((obj plump:element) &rest initargs)
  (add-object-clause 'plump:element obj))

add-object-clauseは、PAIPrologのadd-clauseを少し改造しただけのものです。
項が増えるとシンボルにぶら下がる情報が多くなり過ぎる気がしますが、とりあえず実験なのでこれでよしとします。

(defun add-object-clause (name obj &key asserta)
  (let ((pred name))
    (assert (and (symbolp pred) (not (variable-p pred))))
    (pushnew pred *db-predicates*)
    (pushnew pred *uncompiled*)
    (setf (get pred 'clauses)
      (if asserta
          (nconc (list (list (list name obj))) (get-clauses pred))
          (nconc (get-clauses pred) (list (list (list name obj))))))
    pred))

これで、ウェブページを取得し、plump:parseした時点でPrologの項が登録されます。

(plump:parse (dex:get "https://www.shop-shimamura.com/disp/itemlist/001002001/"))
→ #<plump-dom:root 4250272873>

CSS Selectorでの問い合わせ的にするために、問い合わせのユーティリティとして、ノードの"class"属性を根の方向に探索するclass-namedというのを定義してみます。
なお、子→親の方向で検索するのは、要素を項としている都合上です。

(defun class-named (class node)
  (typecase node
    (plump:root NIL)
    (T (cond ((plump:attribute node "class")
              (and (equal class (plump:attribute node "class"))
                   node))
             (T (and (class-named class (plump:parent node))
                     node))))))

これでこんな風に書けます。

(prolog
  (plump::element ?elt)
  (is ?tag (plump:tag-name ?elt))
  (= ?tag "img")
  (is ?ans (class-named "card__thumb" ?elt))
  (is T (not (null ?ans)))
  (lisp (format T
                "~A: ~A~%" 
                (plump:attribute ?ans "alt")
                (plump:attribute ?ans "src"))))
▻ メンズ ワッフルトレーナー(SEASON REASON): https://img.shop-shimamura.com/items/images/01/0120800000660/01_0120800000660_111_l.jpg
▻ メンズ ワッフルトレーナー(SEASON REASON): https://img.shop-shimamura.com/items/images/01/0120800000660/01_0120800000660_113_l.jpg
▻ メンズ ワッフルトレーナー(SEASON REASON): https://img.shop-shimamura.com/items/images/01/0120800000660/01_0120800000660_215_l.jpg
▻ メンズ トレーナー(SEASON REASON): https://img.shop-shimamura.com/items/images/01/0120800000659/01_0120800000659_111_l.jpg
▻ メンズ トレーナー(SEASON REASON): https://img.shop-shimamura.com/items/images/01/0120800000659/01_0120800000659_113_l.jpg
▻ メンズ トレーナー(SEASON REASON): https://img.shop-shimamura.com/items/images/01/0120800000659/01_0120800000659_214_l.jpg
▻ メンズ トレーナー(SEASON REASON): https://img.shop-shimamura.com/items/images/01/0120800000659/01_0120800000659_305_l.jpg
▻ メンズ プルパーカ(SEASON REASON): https://img.shop-shimamura.com/items/images/01/0120800000657/01_0120800000657_312_l.jpg
▻ メンズ プルパーカ(SEASON REASON): https://img.shop-shimamura.com/items/images/01/0120800000657/01_0120800000657_305_l.jpg
▻ メンズ プルパーカ(SEASON REASON): https://img.shop-shimamura.com/items/images/01/0120800000657/01_0120800000657_307_l.jpg
▻ メンズ裏毛プルパーカ(呪術廻戦): https://img.shop-shimamura.com/items/images/01/0128200004027/01_0128200004027_213_l.jpg
▻ メンズ裏毛プルパーカ(呪術廻戦): https://img.shop-shimamura.com/items/images/01/0128200004026/01_0128200004026_212_l.jpg
▻ キャラクタートレーナー(呪術廻戦): https://img.shop-shimamura.com/items/images/01/0123200005469/01_0123200005469_212_l.jpg
▻ キャラクタートレーナー(呪術廻戦): https://img.shop-shimamura.com/items/images/01/0123200005468/01_0123200005468_213_l.jpg
▻ キャラクタートレーナー(にゃんこ大戦争): https://img.shop-shimamura.com/items/images/01/0123200005379/01_0123200005379_213_l.jpg
▻ キャラクタートレーナー(にゃんこ大戦争): https://img.shop-shimamura.com/items/images/01/0123200005378/01_0123200005378_212_l.jpg
▻ キャラクターパーカ(にゃんこ大戦争): https://img.shop-shimamura.com/items/images/01/0123200005377/01_0123200005377_211_l.jpg
▻ メンズ裏毛トレーナー(ブラッククローバー): https://img.shop-shimamura.com/items/images/01/0128200004042/01_0128200004042_112_l.jpg
▻ メンズ裏毛プルパーカ(ブラッククローバー): https://img.shop-shimamura.com/items/images/01/0128200004041/01_0128200004041_211_l.jpg
▻ メンズ裏毛プルパーカ(ブラッククローバー): https://img.shop-shimamura.com/items/images/01/0128200004040/01_0128200004040_213_l.jpg
▻ しまむらロゴパーカ: https://img.shop-shimamura.com/items/images/01/0123200005278/01_0123200005278_201_l.jpg
▻ しまむらロゴトレーナー: https://img.shop-shimamura.com/items/images/01/0123200005277/01_0123200005277_212_l.jpg
→ nil

clssでCSS Selectorで書くと

(clss:select ".card__thumb img")

一行ですが、CSS Selectorの細かい規則を覚えるのも大変ですし、組み込みPrologで一本化できると嬉しいと思いたい。

木構造オブジェクトの問い合わせ言語は様々あるのですが、これをどうにか組み込みPrologで一本化できないか今後も探っていきたいと思います。
とりあえずは、PrologでJSON等の木構造の問い合わせをどうやっているか調査した方が良いかもしれない……。


HTML generated by 3bmd in LispWorks 7.0.0

2020年振り返り

Posted 2020-12-31 14:50:55 GMT

恒例になっているので今年も振り返りのまとめを書きます。

Lisp的進捗

昨年は自分的にMOPブームでしたが、今年はMOPでプログラミングできる知識が大体揃って来た感じで、実際のプログラムでも普通に活用できたりするようになりました。
といっても大した応用ではないのですが、普通の道具になった、位のところです。

CLOS MOPだと大別すると、

  • メタクラスの定義
  • メタクラスの継承関係の処理(デフォルトの挙動、メタクラスのmixin時の挙動の定義等々)
  • スロット定義
  • オブジェクトの(再)初期化
  • スロットへのアクセス方法

位が大きなトピックで他は上記の組み合わせか、細々としたところなので、クックブック的な感じでまとめておくと便利かなと思ったりしています。

ブログ

今年書いた記事は62記事でした。
まあまあ書いた方だとは思いますが、ネタ自体はストックが100記事分位はあるので、一旦全部出し切りたいところです。

LispWorks

LispWorksを購入してから五年半経過しましたが、すっかりSLIME+SBCLの環境よりLispWorksで書く方が楽になってしまいました。
単なる慣れというところもありますが、IDEとしてはSLIME+SBCLより統合されていて便利なところが多いです。まあもちろんエディタ単体ではHemlock(LispWorksのエディタ)よりGNU Emacsの方が高機能ですが。

仕事では、LispWorksで社内アプリ(Macのデスクトップアプリ)を量産していて、直近の業務で必要なツールを作成していていつの間にか20種類位になりました。
エンジニアでない人にGitHubを使ってもらうのに、GUIで簡単なラッパーを作成したり、社内業務のオートメーションでLispWorksが使えそうなところを見付けたら即投入しています。
Unixのシェルスクリプト、Google Apps Script、等々オートメーションのツールはありますが、手早く書捨てのGUIのアプリを作成できるという点では割とLispWorksは良いと思っています。

2021年の方向性

Lisp界隈もだいぶ盛り下がってきた感じで、当ブログももう誰も読んでない感じになってきました。
盛り上げる方法は多分ないのですが、文章のアウトプットは好きな方なので、ニッチなネタを垂れ流していきたいと思います。

また、13年位Lispコミュニティを眺めていますが、いまだLispに関する知識が1980年代な人を多く目にするのが不思議です。
恐らく古い書籍の情報をソースにしたものが再生成されているのではないかと思うのですが、このような傾向をアップデートすべく、2021年はWikipedia等の化石化した情報も更新したりすることにも取り組んでみようかなと思います(がWikipediaの更新は手間がかかる)

過去のまとめ


HTML generated by 3bmd in LispWorks 7.0.0

初期のECLはPrologと融合していたらしい

Posted 2020-12-28 22:07:24 GMT

いつものようにCommon Lisp情報を求めてインターネットを徘徊していたのですが、ECLのマニュアルににCRSというのがあるのが気になって調べてみました。

  • What is ECL

    ECL is based on a Common Runtime Support (CRS) which provides basic facilities for memory management, dynamic loading and dumping of binary images, support for multiple threads of execution.

CRS(Common Runtime Support)

ECLのマニュアルの説明では、CRSは、メモリ管理やスレッド等の実行時に必要なものがモジュール化されたものという感じですが、CRSはECLとも独立した存在のようで、CRSについて別途論文も書かれていました。

こちらの論文を読むと、CRSとはCを中間言語として、実行時に必要な言語機能をモジュール化したり、データ形式を統一したものだったようで、CRSを基盤にCや、Lisp、Prologの環境が構築可能で、それぞれの言語が双方向に呼び出し可能な仕組みだったようです。

;;; Prolog機能を使ったCommon Lispのコード例
(defun reverse (x y) 
  (trail-mark)
  (or (and (get-nil x) ;reverse([],[]). 
           (get-nil y)
           (success))
      (trail-restore)
      (let (x1 x2 (y2 (make-variable)))
        (and 
         (get-cons x)
         (unify-variable x1)
         (unify-variable x2)
         (goals
          (reverse x2 y2) ; :- reverse(X2,Y2), 
          (concat y2 (list x1) y)))))
  (trail-unmark))

この論文の後ろの方に出てくるCommon Lispの処理系はECLではなく、Delphi Common Lisp(DCL)というECLの作者であるAttardi先生が1985年に起業したイタリアのベンチャーが販売していた商用処理系なのですが、古いECLのソースを確認すると、ECLは元々はこのDCLのCLOS部やCRS部分がECoLispとしてGPLライセンスで公開されたもののようです。

ECoLisp(Embeddable Common Lispの略)の略でECLとしていたものが、いつのまにかEmbeddable Common Lispの略でECLになったらしいのですが、別にECoLispのままでも良かったような……。

This is ECoLisp (ECL), an Embeddable Common Lisp implementation

Copyright (c) 1990, 1991, 1993 Giuseppe Attardi

Authors: KCL: Taiichi Yuasa and Masami Hagiya Dynamic loader: William F. Schelter Conservative GC: William F. Schelter Top-level, trace, stepper: Giuseppe Attardi Compiler: Giuseppe Attardi CLOS: Giuseppe Attardi with excepts from PCL by Gregor Kiczales Multithread: Giuseppe Attardi, Stefano Diomedi, Tito Flagella Unification: Giuseppe Attardi, Mauro Gaspari

なお、現状資料が見当たらないので推測に過ぎませんが、KCLにマルチスレッドやCLOS、X11のGUIを付けて商用化されたものがDCLで、ECLは、それをCRSとAKCLをベースに構築しなおしたものなのかなと考えています。

CRSとPrologは何処へ

ECoLisp 0.12をSunOSのエミュレータでビルドして確認してみましたが、この頃までは、CRS部はまだ独立していますが、既にユニフィケーション部はほぼ残骸だけとなり、上記のLispからProlog機能を使うようなコードは書けなくなっています。

CLOS部もPortable CommonLoops(PCL)とは独立の実装で、class-prototypeの代わりに、先にmetaclassクラスを作っておくという独自方式でしたが、徐々にAMOP準拠に書き換えられた様子。
とはいえ、まだ結構な量が健在です。

まとめ

折角面白い機能であったCRSとProlog連携でしたが、どうも1990年代中盤には、ECLのコードからも削除されつつあり利用できなくなっていたようです。残念!

Poplogも共通の言語基盤を通して、Common LispとProlog、ML、Pop-11が連携しますが、あまりこういうのは流行らないのでしょうか。割合に面白いと思うのですが……。

なお、今回始めて知りましたが、Attardi先生は、元々はHewitt先生の元でアクター理論を研究していた方だったようです。
Delphi Common Lispも1980年代中後半にCLOSとX11上のGUI、マルチスレッド機能が使えたワークステーション上の処理系ということで大分時代を先取りしていたようですね。


HTML generated by 3bmd in LispWorks 7.0.0

井田昌之先生の公式ページに貴重なCommon Lispの資料が満載

Posted 2020-12-24 20:30:34 GMT

Lispの調べ物をしてインターネットを彷徨っていたところ、井田昌之先生が公開されている歴史的資料のページに辿り着きました。

なんとCommon Lisp系を中心として歴史的な資料が満載ではないですか。
下記にLisp系の資料を抜粋したリンクを適当なコメントと共に並べてみます。

1973

1970年代は、Lisp 1.5 との出会いから、Intel 8080上で動くLispマシンである、ALPS/Iの開発を中心に研究されていたようです。
所謂マイコンといわれていたCPU上でLispを動かす研究としてはかなり初期の取り組みではないでしょうか。

1976

1977

1978

1979

1981

1980年代前半は、ALPS/Iの開発と並行して当時擡頭してきたAIマシン(Lispマシン)も研究されていたようです。

1984

1985

1984年にCommon Lispが登場しますが、それまでのマイコンLispの研究をバックグラウンドに、Common Lispのサブセットを検討されたり、Common Lispのオブジェクトシステムについて研究をされていたようです。

1986

1987

1986年あたりから電子メールを基盤とした議論について等も研究されている様子、また、ISO版Lispについての議論が盛り上がりつつあったことが判ります。

1988

ANSI CLに取り込まれる予定のCLOSがかなりまとまった頃で、CLOS的にはかなり熱い時期だったようです。

1989

1990

ネットワーク透過なウィンドウツールキットであるYYonXの研究、ヨーロッパで擡頭してきた米国Common Lispへの対抗馬であるEuLisp等が熱い時期だったようです。
ワークステーション文化も花盛りという感もあり、キャンパスネットワーク等の研究もされていたようです。

1991

1992

1993

1994

1995

この辺りからLisp関連の研究は一段落され、当時擡頭してきたJavaの方に研究の軸足を移された様子。
また自由ソフトウェア運動の紹介等もされていたようです。

Emacsでは、レキシカルスコープは遅いのでダイナミックスコープを採用した、というのが通説ですが、この下記のインタビューではレキシカルスコープは速度と名前の競合回避には良いが、実装が簡単なのでダイナミックスコープを採用したとありますね。
レキシカルスコープは遅い説はどこが出所だったかな(History of T)だったような。

1996

1997

2001

2002

まとめ

まだまだ資料を全部は読み込めていないのですが、1980年代後半のCLOS系の資料や、Lispの国際規格化での各国の思惑等が伺える資料はかなり貴重だと思います。


HTML generated by 3bmd in LispWorks 7.0.0

allocate-instanceアドベントカレンダー総括

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

allocate-instance Advent Calendar 2020 25日目の記事です。

アドベントカレンダーも参加者が少ないと最後に総括エントリーという必殺技を使ってエントリーを埋めることができます。

オブジェクトのアロケーションなら原理は簡単なので、ニッチすぎるアドベントカレンダーでも参加者もそこそこいたりするかなと思いましたが、結局一人で完走ということになりました。

なんとなくですが、最後まで何故allocate-instanceに着目したのかが判らない、という感じだったかもしれません。

私としては、アドベントカレンダー開幕で書いたとおり、スロットストレージにベクタ以外が使うというアイデアがあまり活用されていないところに着目したわけですが、活用されないだけあったアイデアであることを証明してしまったのかもしれません。

また、Common Lispではアロケートより後のプロトコルでできることが強力で、オブジェクトのIDとクラス情報だけあれば後はどうとでもできるのがallocate-instanceをいじる意義を低下させている気がします。

実際の活用例でいうと、オブジェクトの永続化あたりでallocate-instanceの話も少し出てきたりもしますが、allocate-instanceは基本的にオブジェクトIDの割り付け程度かなと思います。

やりのこしたこと

振り返ってみると、allocate-instanceのinitargsを活用する例を追求しなかったのが若干悔まれます。
といっても、allocate-instanceにストレージの種類を伝える程度な気はしますが。

あとはハッシュテーブルのストレージがベクタであることを利用して、先頭をオブジェクトのストレージにして、残りをハッシュテーブルにするというのを考えましたが、別に一本にする必要もないかなというところです。

他にも、どうしようもないアイデアはありますが、そのうち試してブログに書いてみたいと思います。

さて、次にアドベントカレンダーを企画した際にはさらにニッチなところを攻めたいと思います。
次回までごきげんよう!


HTML generated by 3bmd in LispWorks 7.0.0

allocate-instanceが関係してくるプロトコルを眺める: Tiny CLOS篇

Posted 2020-12-23 18:10:10 GMT

allocate-instance Advent Calendar 2020 24日目の記事です。

引き続き、allocate-instanceが関係してくるInstance Structure Protocol(ISP)周りを中心に色々なCLOS MOP系の処理系で確認していきたいと思います。

今回は、Tiny CLOSのallocate-instance周りを眺めます。
Tiny CLOSは、CLOS風のオブジェクトシステムを採用しているSchemeではTiny CLOSかその派生が採用されていることが多いようです。
作者が、CLOSおよびに参照実装であったPortable CommonLoopsに深く関わり、AMOPの著者でもあるKiczales先生というのもポイントが高いかもしれません。

大体の構成は、先日紹介したKiczales先生が1990年代前半に考えていた新しいInstance Structure Protocolの構成と同一のようです。

Object Creation and Initialization

  • allocate-instance
  • make
  • initialize

Tiny CLOSでのインスタンスの構成ですが、instance-tagclassという先頭二つの部分と後半のスロット要素からなるベクタ表現されています。ベクタにしたかったというより、1992年のSchemeに構造体がないので、こういう構成にしたのかもしれません。
CLOSの実装でいうwrapper部は、そのままクラスメタオブジェクトの表現です。

ベクタ一本の表現なので、スロット部のベクタだけ取り出すようなことはなく、基本的に先頭2つのオフセットでアクセスする感じになります。

なお、Tiny CLOSはScheme(Common Lisp版もある)の実装なので、allocate-instanceの中身をいじれますが、OOPSが融合している処理系ではC等の実装言語レベルに直結していることが多いようで、安直に下請け関数がアロケートするスロットストレージをベクタからハッシュにすげかえてみる、等のことはやりにくいようです。
なお、Common LispでもECL等がそういう実装になっています。

Instance Structure Protocol

  • slot-ref
  • slot-set!
  • lookup-slot-info
  • compute-getter-and-setter

スロットストレージの並び順は、CLと同様compute-slotsで確定するようです。
スロットの名前と位置の変換は、compute-getter-and-setterでゲッターとセッターのクロージャー生成する際にクロージャーの中に位置が埋め込まれる方式です。
slot-ref内で、lookup-slot-infoによりこのgetters-n-setters情報からゲッター/セッターを取り出してオブジェクトに適用、という流れになっています。

まとめ

Tiny CLOSは、スロット名とスロット位置変換の仕組みとして、位置情報を含んだゲッター/セッターをクラスメタオブジェクト内にまとめて管理、という方式のようです。
CLOS系OOPSそれぞれ微妙に違いますが、位置情報をクロージャーに閉じ込める方式の方が若干速いかなとは思います。
アクセサを定義すれば、標準のケースでは最適化された場合、スロットストレージへの直接アクセスになると思うので、Common Lispでは速度にこだわるなら、slot-valueは使うなというところなのでしょうか。この辺りどこかでそんな文献読んだことがある気がするのですが思い出せない……。


HTML generated by 3bmd in LispWorks 7.0.0

allocate-instanceが関係してくるプロトコルを眺める: TELOS篇

Posted 2020-12-23 02:46:42 GMT

allocate-instance Advent Calendar 2020 23日目の記事です。

引き続き、allocate-instanceが関係してくるInstance Structure Protocol(ISP)周りを中心に色々なCLOS MOP系の処理系で確認していきたいと思います。

今回は、TELOSのallocate-instance周りを眺めます。
TELOSは、EuLispのオブジェクトシステムで、EuLispもCommon Lispより簡潔な作りを指向しています。
EuLispとCommon Lispとの目立った違いは、EuLispがLisp1であることで、クラスの表記も他のシンボルと競合しないように、<foo>のように表記する慣習があります。

ちなみに、ISLISPは、EuLispの影響下にあるので、Lisp2なのに<foo>と表記します。

Object Creation and Initialization

  • allocate
  • make
  • initialize

まず、インスタンスの構成ですが、classslotsという二つの部分からなるprimitive-class構造体で表現されています。CLOSの実装でいうとwrapper部は、そのままクラスメタオブジェクトで表現されています。

インスタンスのストレージは標準でベクタ。 スロットストレージへは、primitive-class-slots、wrapperの取り出しは、primitive-class-ofで行えますが、クラスそのものなので別に必要ないかも?
CLOS MOPと異なる点としては、クラスがスロット数を保持するclass-instance-lengthを有します。

Instance Structure Protocol

  • slot-value
  • (setf slot-value)
  • primitive-slot-value
  • (setf primitive-slot-value)
  • slot-value-using-slot
  • find-slot
  • slot-reader
  • slot-writer
  • compute-slots
  • primitive-ref
  • setter-primitive-ref
  • primitive-find-slot-position

スロットストレージの並び順は、CLと同様compute-slotsで確定するようです。 CLOSのslot-definitionに相当する<slot>クラスがあり、class-slotsに格納されていますが、スロットの位置を計算するには、primitive-find-slot-positionを使います。
特に最適化はされておらず、class-slotsの中を順に探しているだけです。

(primitive-find-slot-position <simple-class> 'c (class-slots <foo>) 0)
→ 2

CLのstandard-instance-accessに相当するものは、primitive-refになります。 slot-valueの中で、標準のメタクラスかどうかを判定するようになっており、標準であれば、slot-value-using-slotが、スロットのslot-reader/writerを呼び出しを値を取り出します。
slot-readerは最終的にはprimitive-refを呼びます。

slot-value

(slot-value-using-slot (find-slot (class-of obj) name)
                       obj)

と展開されるので、何もしなければ、find-slotが探索してスロット名→スロット位置の変換をするので遅いですが総称関数なので(find-slot obj 'a)等を特定化して定義してやれば高速化はできそうです。

まとめ

CLOS系OOPSでスロット名からスロットの位置を割り出す方法にそれぞれ色々と工夫があるようです。
アクセサに比べてslot-valueの方がプリミティブな雰囲気があり、速度もアクセサより速そうな印象がありますが、MOPの仕組みからして、スロットの位置割り出しが計算済みの分アクセサの方が速いですね。


HTML generated by 3bmd in LispWorks 7.0.0

allocate-instanceが関係してくるプロトコルを眺める: MCS篇

Posted 2020-12-21 20:53:44 GMT

allocate-instance Advent Calendar 2020 22日目の記事です。

前回に引き続き、allocate-instanceが関係してくるInstance Structure Protocol(ISP)周りを中心に色々なCLOS MOP系の処理系で確認していきたいと思います。

今回は、MCSのallocate-instance周りを眺めます。
まず、MCSですが、The Meta Class Systemの略で、ObjVlispの流れをくみつつCLOSとの互換性も高いシステムです。

MOPも大体同じような構成になっていますが、MCSの方がシンプルでありつつ抽象クラスやmixinクラス等も用意されていて色々整理されているようにも見えます。

Object Creation and Initialization

  • allocate-instance
  • make-instance
  • initialize-instance
  • change-class
  • change-class-using-class

さてまず、インスタンスの構成ですが、isitslotsという二つの部分からなる構造体で表現されています。isitというのはCLOSの実装でいうとwrapperですが、クラスメタオブジェクトを一つ含んだリストで表現されていて、wrapperとclassのオブジェクトがほぼ一本化されています。

インスタンスのストレージは標準ではベクタです。 スロットストレージへは、mcs%-slots、wrapperの取り出しは、mcs%-isitで行えます。
CLOS MOPと異なる点として、スロット名から、スロットストレージの位置を割り出す関数がクラスの中に格納されている点で、標準では、general-slot-position関数が、class-slot-accessorに格納されています。

Instance Structure Protocol

  • slot-exists-p
  • slot-boundp
  • slot-makunbound
  • slot-value
  • mcs%slot-value
  • (setf slot-value)
  • mcs%set-slot-value
  • mcs%set-slot-value-low
  • compute-slots
  • mcs%local-slot-indexed
  • mcs%local-slot-indexed-low

スロットストレージの並び順は、CLと同様compute-slotsで確定するようです。 スロットの位置を計算する関数がクラスに含まれているので、slot-definition-locationは存在せず、%slot-location-ofが位置計算用関数を呼び出して計算します。

CLのstandard-instance-accessに相当するものは、mcs%local-slot-indexed-lowになりますが、slot unboundのサポートありのmcs%local-slot-indexedも用意されています。

CLと違ってslot-valueはマクロになっており、slot-value-using-系メソッドはなく、mcs%slot-valueに展開か、メソッド内部での最適化として、mcs%local-slot-indexed-lowを用いたアクセスになるよう展開するようです(なお実装ではそこまで最適化されていない)

mcs%slot-valueは、上述のスロット位置を名前から割り出す関数を呼び出して、インスタンスのストレージを添字でアクセスします。
なお、-lowが掴ないものは、slot unboundをサポートせずslot missingのみサポートします。

まとめ

MCSではslot-value-using-classが省略されていますが、その代わりにクラスがスロット名→ストレージの位置の変換関数を保持するというのが面白いと思いました。
この辺りの方式の違いをそのうち比較してみたいところです。


HTML generated by 3bmd in LispWorks 7.0.0

allocate-instanceが関係してくるプロトコルを眺める: Common Lisp篇

Posted 2020-12-20 17:40:41 GMT

allocate-instance Advent Calendar 2020 21日目の記事です。

ネタ切れも甚しいのでallocate-instanceが関係してくるInstance Structure Protocol(ISP)周りを中心に色々なCLOS MOP系の処理系で確認していきたいと思います。

まずは、本家Common Lispです。

Instance Structure Protocol

  • CLOS MOP: Instance Structure Protocol

  • slot-exists-p

  • slot-boundp

    • slot-boundp-using-class
  • slot-makunbound

    • slot-makunbound-using-class
  • slot-value

    • slot-value-using-class
  • (setf slot-value)

    • (setf slot-value-using-class)
  • compute-slots :around

  • slot-definition-location

  • standard-instance-access

  • funcallable-standard-class

  • funcallable-standard-instance-access

ISPで列挙されているのは、スロットアクセス系の関数/メソッドになり、allocate-instance等は埒外です。
ます、関係してくる順序としては、スロットストレージの並び順がcompute-slots :aroundで確定し、インスタンスのストレージとスロットの位置が確定します。それに伴なって、slot-definition-locationの値も決まり、standard-instance-accessでのアクセスの添字も決まる、という感じです。

slot-valueの下請けが、slot-value-using-classで、更に下請けが、standard-instance-accessとされていますが、処理系によっては、slot-valueからインスタンスのストレージに直通の場合もあるようです(LispWorksでスロットアクセスの最適化が有効になっている場合など)

standard-instance-accessは、インスタンスのストレージに添字でアクセスする低レベルの関数ですが、standard-と付いていることから判るように、standard-objectを想定しています。
standard-objectとはインスタンスのストレージ構成が違う場合には使えないと考えた方が良いでしょう。

Class finalization protocol

継承関係の確定のプロトコルですが、インスタンスがアロケートされる前に確定している必要があるとされており、allocate-instanceが呼ばれる前にclass-finalized-pで調べて確定していなければ、finalize-inheritanceが呼ばれるとされています。

この判定のタイミングですが、Robert Strandh先生によれば、allocate-instanceの引数のinitargsは確定後の計算結果になるので呼ばれる前に確定している筈としていてPCLでも、make-instancefinalize-inheritanceを呼んでいると註記していますが、PCL系であるSBCL等では、allocate-instanceの中で呼ばれています(ensure-class-finalized経由)。

大抵の処理系では、finalize-inheritanceを呼んでいるので、実際のところ必須なのかそうでないのか。ちなみに自分はStrandh先生を信じて今回のアドベントカレンダでは呼ばないスタイルで通しました。

Object Creation and Initialization

  • make-instance
  • shared-initialize
  • change-class
  • update-instance-for-different-class
  • update-instance-for-redefined-class

あたりですが、インスタンスストレージの構成が標準と異なる場合は、初期化/再初期化の手続を別途記述する必要が出てきます。
また、標準的な構成とカスタマイズしたものとでchange-classする場合は、インスタンスストレージの確保も別途記述する必要も出てきます。
大抵は、上記メソッドと標準メソッドコンビネーションでどうにかできますが、もしかしたら、標準から外れる場合は、Dependent maintenance protocolでストレージ形式の修正をしたりした方が良いのかもしれません。

まとめ

関係プロトコルをざっと眺めてみましたが、allocate-instanceをカスタマイズする例がほとんどないですね。
思えば、allocate-instanceのカスタマイズは、大抵は初期の文献に見付かるのですが何故なのか(共通仕様をまとめるのが難しいとか?)


HTML generated by 3bmd in LispWorks 7.0.0

virtual slotをallocate-instanceレベルで考えてみる

Posted 2020-12-19 21:12:58 GMT

allocate-instance Advent Calendar 2020 20日目の記事です。

MOPの応用として、仮想的なアロケーションの場所を指定する例があります。

大抵は、スロットの:allocation指定で、:virtual等を指定するという感じですが、allocate-instance内でどうにかできないか考えてみます。 allocate-instance内でどうにかするという縛りなので、スロットストレージに関数を詰めて呼び出すという作戦で実行時にデータを取得できるようにしてみます。

(defpackage "f53e7180-1934-50c0-9c43-7c6a79b7a5e2" 
  (:use c2cl slotted-objects))

(cl:in-package "f53e7180-1934-50c0-9c43-7c6a79b7a5e2")

(defclass virtual-class (slotted-class) ())

(defclass virtual-object (slotted-object) () (:metaclass virtual-class))

(defmethod allocate-slot-storage ((class virtual-class) size initial-value) (let ((storage (make-sequence 'vector size)) (fctns (make-sequence 'vector size))) (dotimes (index size fctns) (setf (elt fctns index) (let ((index index)) (lambda (op value) (case op (:get (elt storage index)) (:set (setf (elt storage index) value)))))))))

(defmethod slot-value-using-class ((class virtual-class) instance (slotd slot-definition)) (funcall (elt (instance-slots instance) (slot-definition-location slotd)) :get 'ignore))

(defmethod (setf slot-value-using-class) (value (class virtual-class) instance (slotd slot-definition)) (funcall (elt (instance-slots instance) (slot-definition-location slotd)) :set value))

微妙に使い勝手が悪いですが、とりあえず下記のように書けます。 スロット読み出しが発生すると、スロットストレージに詰められたクロージャーが呼ばれ、値を計算します。

(defclass 56nyan (virtual-object)
  ((name)
   (code :initarg :item-code)
   (price))
  (:metaclass virtual-class))

(defun get-56nyan-page (code) (babel:octets-to-string (drakma:http-request (format nil "https://www.56nyan.com/fs/goronyan/~A" code) :force-binary T) :encoding :cp932))

(defmethod allocate-slot-storage ((class (eql (find-class '56nyan))) size initial-value) (let* ((fcns (call-next-method)) (slotds (class-slots class))) (labels ((name->loc (name) (slot-definition-location (find name slotds :key #'slot-definition-name))) (slot-fctn (name) (elt fcns (name->loc name))) ((setf slot-fctn) (fctn name) (setf (elt fcns (name->loc name)) fctn)) (code () (funcall (elt fcns (name->loc 'code)) :get nil))) (setf (slot-fctn 'name) (lambda (op value) (declare (ignore value)) (case op (:get (plump:attribute (elt (clss:select "meta[property=og:title]" (plump:parse (get-56nyan-page (code)))) 0) "content")) (:set nil)))) (setf (slot-fctn 'price) (lambda (op value) (declare (ignore value)) (case op (:get (plump:text (elt (clss:select ".itemPrice" (plump:parse (get-56nyan-page (code)))) 0))) (:set nil))))) fcns))

実行してみる

allocate-instanceレベルで実現する意義を考えてみましたが、change-classしても値がスムースに移行可能なのではないでしょうか。

(defclass 56nyan-static ()
  ((name)
   (code :initarg :item-code)
   (price)))

(let ((obj (make-instance '56nyan :code "7e003-001"))) (change-class obj '56nyan-static) (describe obj)) ⇒ #<56nyan-static 42000B7D3B> is a 56nyan-static name "アカナ グラスランド キャット 340g (42341) 【正規品】" code "7e003-001" price "1,093円"

まとめ

そもそも、Common Lispの場合、スロットのリーダ/ライタでメソッドコンビネーションが使えるので、Virtual Slotsのようなものはあまり必要ないような気もします。

ちなみに、今回のchange-classの用法ですが、Common Lisp Proメーリングリストのchange-classの議論で、とりあえずデータをロードして、change-classで正規化するのが便利、という用例紹介をちょっと真似してみました(今回は正規化してませんが)

自分も以前、change-classの使い方として試してみたことがあった気がしますが、こういう応用も無くはないのかなと思います。


HTML generated by 3bmd in LispWorks 7.0.0

Older entries (2383 remaining)