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

• CLtL2: with-added-methods

ローカルな総称関数の構文としては、with-added-methods以外にも、lambdaに相当するgeneric-function、flet/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-methodsでfib(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

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

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

• keyboard - How to disable command-Q for Quit? - Ask Different

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

手順

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

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

まとめ

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

■

HTML generated by 3bmd in LispWorks 7.1.3

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って試したことがなかったので、この機会に試してみることにしました。

Cで書かれたルーチンを呼ぶ方法。この手の話、大事だと思うけどあまり書かれていない。過去のbitで説明があったのはAPPLE LISPのCALLくらい？ pic.twitter.com/dycR4tjaAI

— zick (@zick_minoh) January 3, 2022

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

• Living Computers: VAX-7000/640

まず、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))

• VAX LISP User's Guide Ver 2.2

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

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

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

• LispWorks 8.0 | Delivery User Guide: 14 Efficiency considerations when coding for delivery

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

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

■

HTML generated by 3bmd in LispWorks 8.0.0

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

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

• SRFI Template

■

HTML generated by 3bmd in LispWorks 8.0.0

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があります。

• KMRCLを眺める(234) repl.lisp

■

HTML generated by 3bmd in LispWorks 8.0.0

bit 1985年6月号 Common Lisp入門 超マシン誕生のデータゼネラル社もCommon Lispを作ってた、と pic.twitter.com/JfSEAPoTYy

— ほうめい　マイコンで遊んでばっかりで (@houmei) December 31, 2021

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

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

• The Development of Chez Scheme

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

■

HTML generated by 3bmd in LispWorks 8.0.0

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

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コミュニティについての考察みたいなものも大体まとまってきたので、そのうち書いたりしてみようかなと思ったりもしています。

過去のまとめ

• #:g1: 2020年振り返り
• #:g1: 2019年振り返り
• #:g1: 2018年振り返り
• #:g1: 2017年振り返り
• #:g1: 2016年振り返り
• #:g1: 2015年振り返り
• #:g1: 2014年振り返り
• #:g1: 2013年振り返り
• #:g1: 2012年振り返り
• #:g1: 2011年を振り返る
• #:g1: 2010年を振り返る
• #:g1: 2009年を振り返る
• #:g1: 今年一年をふりかえる

■

HTML generated by 3bmd in LispWorks 8.0.0

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

Franz Lisp、そんなことできたのか pic.twitter.com/N3PdgYKIZ5

— zick (@zick_minoh) December 28, 2021

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

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

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

• Lisp₂とFUNCALL

処理系は、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の関数/マクロ定義は括弧を定義しているのに感覚として近いと考える所以です。

関連

• Lisp₂のマクロはいうほど不衛生でもない

■

HTML generated by 3bmd in LispWorks 8.0.0

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

byte-stream.lisp を眺める

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

make-binary-array-output-stream、get-output-stream-data、dump-output-stream-data、make-byte-array-input-streamの4つですが、make-binary-array-output-streamはmake-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-streamとget-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回目。今回は、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を眺めます。

color.lisp を眺める

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

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

• 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.

• CLHS: Declaration TYPE

なので、

    (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を眺めましたが、確認してみるとあと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

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

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

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

(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のリンクを貼っておきます。

• g000001/destructuring.lisp

これで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マシンマニュアルに詳しい解説があるので、興味のある方は眺めてみてはいかがでしょうか。

• Chinual 6th ed.: Lambda-List Keywords

■

HTML generated by 3bmd in LispWorks 8.0.0

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

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

• AvoidingConfusion in Metacircularity: The Meta-Helix

Meta-Helixというのは、クラス⇔インスタンスの関係に加えて、implemented-ofというインスタンス⇔実装の中身、という関係を入れたことで関係が螺旋状になっているのに由来するようですが、一応論文の流れを解説すると、CLOS MOPとTiny CLOS MOPを検討し、これらが持つ問題をMeta-Helical MOPで解決しようというところです。
AvoidingConfusion in Metacircularityというタイトルですが、CLOS MOPの方ではslot-value⇔slot-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)))

論文の例を試してみる

まず、xとyのスロットを有する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の関係で整理できないか試してみたいところです。

関連

• MOP vs マクロ (1)
• MOP vs マクロ (2)
• MOP vs マクロ (3)
• MOP vs マクロ (4)
• MOP vs マクロ (5)
• MOP vs マクロ (6)
• MOP vs マクロ (7): Gaucheのpropagatedスロット再現
• MOP vs マクロ (8): メソッド定義でselfを使って楽をしたい

■

HTML generated by 3bmd in LispWorks 8.0.0

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で取得できるので、コンパイル時にコンパイラマクロで展開を制御できるのではないかと思ったので、試しに書いてみます。

• CLtL2: 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

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

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

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

• TAG: KMRCL

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

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

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で検索すると文献が結構ありますので興味のある方は眺めてみてはいかがでしょうか。

• Berkeley|EECS: Search: spur

参照

• RISC-Vの誕生　既存の命令セットアーキテクチャでは満足できなかった、その理由
• SPUR Lisp: Design and Implementation
• Features for Multiprocessing in SPUR Lisp

■

HTML generated by 3bmd in LispWorks 8.0.0

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式を書いてみるというのを試してみましたが、データの表記は大抵、括弧で括られています。

• 色々な言語でCommon Lispのコードを書いてみよう

人よっては括弧で括られたものは、何をどうしてもデータに見えてしまうのではないでしょうか。
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

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

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

• undefinedの代わりに$notImplementedを使おう

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

(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

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

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

MCLのエディタヘルプ

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

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

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

• lw-ed-help.lisp

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

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

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

LispWorks 8.0 のコマンドリスト

まとめ

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

■

HTML generated by 3bmd in LispWorks 8.0.0

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/システム関数の型宣言が合ってない

試用の申し込みについて

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

• LispWorks 7購入への道(1)

まとめ

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

関連

• LispWorks IDEの紹介
• LispWorks 7.1 購入への道(3) — バグ報告2件
• LispWorks 7.1 購入への道(2) — Common Prologを試す
• LispWorks 7.1 購入への道(1)
• LispWorks 7購入への道(5) ─ 購入
• LispWorks 7購入への道(4) ─ 試用期間の終わりとアンケート回答
• LispWorks 7購入への道(3) ─ Java連携を試す
• LispWorks 7購入への道(2) ─ StumpWMをLWで
• LispWorks 7購入への道(1)

■

HTML generated by 3bmd in LispWorks 8.0.0

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

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

• LISP MACHINE SOFTWARE MANUAL(CSOFT.20)

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で発見したので眺めていたところ、ヒューイット先生からのメール経由でのレビューも発見しました。

• 31-Dec-77 CARL at MIT-AI (Carl Hewitt): My evaluators

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

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

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

• SAIL CHARACTER SET

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

(defun lexical_apply (procedure arguments expression)
...

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

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

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

関連

• #:g1: 関数名にハイフンを使うようになったのはいつ頃からなのか

■

HTML generated by 3bmd in LispWorks 7.0.0

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

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

マクロ

宏

リーダーマクロ

読取宏

destructuring/分配

解構

スロット

槽

リスト

列表

空リスト

空列表

クォート(引用符)

引号

バッククォート

反引号

パッケージ

包

アナフォリックマクロ

指代宏

シンボル

符号

インターン

扣押

アンインターンドシンボル

自由的符号

ローカル関数

区域函数

総称関数

通用函数

一般化参照

通用化引用

まとめ

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

参考文献

• ANSI Common Lisp 中文翻譯版 (Chinese Translation of ANSI Common Lisp)
• On Lisp 中文版

■

HTML generated by 3bmd in LispWorks 7.0.0

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

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

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

• Object-Oriented Programming: Themes and Variations

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

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

手元のネタ帳に『(the ignore x)ってどうだろう』とメモがあるのですが、declareとtheの類似性から(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方向全部に指定がかかるので、直後の変数にのみ効くというのは、違和感があるかも。

関連

• #:g1: (declare (ignore ignore))が面倒

■

HTML generated by 3bmd in LispWorks 7.0.0

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

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も結果としてサポートされることになります。

• #:g1: 拡張setf定義を眺める: 制御構造篇

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

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

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

• 逆引きCommon Lisp: SBCL:定数の上書きエラーで上書きを選択する

これは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)

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

• #:g1: KMRCLを眺める (31) defconstant*
• #:g1: com.google.baseの紹介: defconst

最近考えた別解

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

(defvar .baz-constant. "baz")
(defconstant baz-constant .baz-constant.)

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

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

まとめ

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

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

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

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

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

■

HTML generated by 3bmd in LispWorks 7.0.0

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

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

• What is Gradual Typing: 漸進的型付けとは何か

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畑の研究なのかと思ったりもしましたが、

• Gradual Typing for Functional Languages

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のマニュアルを確認してみると

• Bigloo Manual

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もコンパイル時の静的チェックサポートしている、という印象が強くなったのではないでしょうか。

• #:g1: declare type 対 check-type

ちなみに、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一人 Advent Calendar 2021 7日目の記事です。

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

イメージのダンプとは

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

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

• #:g1: LISPイメージにとにかくなんでも入れて置くと便利
• #:g1: モンスターコアの作り方
• #:g1: Quicklisp全部入りコアを作ろう

このイメージのダンプですが、何故かネガティブなイメージを持っている人がそこそこいるようなのが不思議なのですが、単純にいえば、コンパイル済みの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一人 Advent Calendar 2021 6日目の記事です。

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

• GIGAZINE: 戦国時代だったテキストエディタ界をVisual Studio 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一人 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の開発にも関わりが深いようです。

• Franz Inc. Chief Scientist John Foderaro part of the UC-Berkeley RISC team receiving IEEE Milestone Recognition

Common Lisp界隈

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

• Scott Fahlman 36歳
• Richard P. Gabriel 35歳
• Guy L. Steele Jr. 30歳
• David A. Moon 30代前半
• Daniel Weinreb 25歳

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

その他

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

まとめ

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

■

HTML generated by 3bmd in LispWorks 7.0.0

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

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

• #:g1: データの検索に組み込みPrologを使ってみる(1)
• #:g1: データの検索に組み込みPrologを使ってみる(2)

プロダクションシステムは、基本的な考え方としては、所謂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")))