すっかり忘れてしまっていましたが、「百年の言語」を体現するarcが公開されたのは、十年前の2008-01-29のことでした。
本当は、今年の01-29に何か書こうと思っていましたが、それさえ忘れて早二ヶ月半……。

arcのソースコードが公開されたのは2008年でしたが、arcで構築されたサイトのHacker Newsは、2007年から稼動しています。
また、名前と構想が発表されたのは、2001年のことなので、かれこれ十八年ともいえなくもないです。

最近のarc

arcの近況を眺めてみましたが、オフィシャルなリリースは、2009-08の3.1から9年間動きなしです。
Hacker Newsを動かしていたのはarcでしたが、2014年にpg氏がY Combinatorの日常業務から引退し、今ではまだarcで動いているのかは良く分からないようです。

軒並動きはないのかと思いましたが、arcのコミュニティが開発しているAnarkiの方は最近も更新があるようです。
Racketに#lang anarkiを作成するなど、なかなか面白そう。

早速、試してみましたが、Racketがインストールされた環境であれば、

raco pkg install anarki

とするだけで導入されます。

あとは、こんな感じで記述しRacketから使えます。 (無理にarcっぽさを出してみました。)

#lang anarki
;;; fib.rkt
(:provide fib)
(def fib (n)
  (if (< n 2)
      n
      (+ (fib:- n 2)
         (fib:- n 1))))

;; Racket
(require "fib.rtk")
(fib 40)
;→ 102334155

むすび

もっと色々書こうと思いましたが、昔の文献を読んでいたらお腹一杯になって満足しました。

参考

• (2012) さあ、Arcをはじめよう | 松村技研
• (2008) Arc's Out
• (2003) 百年の言語
• (2002) なぜArcはとりたててオブジェクト指向でないのか
• (2001) 人気の言語を作るには
• (2001) Arc at 3 Weeks

このブログのarc関係の記事

• https://g000001.cddddr.org/?TAGS=arc

■

HTML generated by 3bmd in LispWorks 7.0.0

defvarには値が設定されている場合には再設定をしないという利点がありますが、開発中などはdefvarの値を再設定したい場合がままあります。

こんな時の為に便利マクロを定義するという記事を読みました。

• defvar で再定義

目立たない機能なのであまり知られていないですが、Emacs系のLispエディタ上ではdefvarのフォームを評価したら値が再設定される、という機能があります。
どうやらdefvarが誕生した(1979年頃)からある機能の様子。
(多分、defvar誕生の頃から扱いがめんどくさいという認識があったのでしょう……)

Zmacs(ZWEI)だと、COM-EVALUATE-REGION-HACKというのがあって、defvarをsetqに置き換えて評価するようです。

slimeだとslime-eval-defunで評価すれば、defvarを認識して下請けのslime-re-evaluate-defvarで値を再設定します。
再設定の方法は、一度makunboundしています。

LispWorksだと、“Evaluate Defun”が“Reevaluate Defvar”を呼んで再設定します。slimeと同じくmakunboundするようです。
エディタ変数editor::evaluate-defvar-actionの値が、:reevaluate-and-warnか:reevaluateの場合だけこの動作になるので好みで入切可能です(デフォルトは有効)

Hemlockだと、“Re-evaluate Defvar” コマンドのみで、“Evaluate Defun”とは連動しないようです。こちらもmakunboundして再設定。

新しい値でsetqするものかと思っていましたが、案外makunboundで処理する方式の方が多いみたいですね。

むすび

“Reevaluate Defvar”は、リージョンを評価した時などにも発動していることがあります。
大抵の開発時は、再評価してもらった方が嬉しいですが、defvarの値設定まわりがどうも不思議な挙動だなと思ったら、確認してみるのも良いかと思います。

関連

• #:g1: SLIMEばつ牛ン (1) slime-eval-defun
• #:g1: Slimy hackathon #1終了!!

■

HTML generated by 3bmd in LispWorks 7.0.0

MIT Lispマシンのソースディレクトリを漁っていたら、MITの最初のLispマシンであるCONS時代のLisp Machine Lispのマニュアルらしきものをみつけたので、html化してみました。

• lmdoc;csoft 20

日付は、1977-06-08ですが、CONS時代のドキュメントであるAIM-444: LISP Machine Progress Reportと照らし合わせてもCONS時代で間違いないようです。

AIM-444の最後に書いてあるように、プロトタイプであるCONSは、1977年に一応の完成となり、1978年あたりから実用を目的としたCADRの開発が始まります。

CONS時代のLisp Machine Lispで興味深い所

EVERYやSOMEはINTERLISPから輸入してきたものであることが書かれていたりします。

また、CONS時代にはまだ、パッケージがないのですが、どうやら接頭辞で管理していたようです。
雰囲気としては今のEmacs Lispに近いですが、これらは、PREFIX REGISTRYのまとまりとして何らかのお作法があった様子。

現在のCommon Lispにも存在するread-from-stringが既にありますが、read-は接頭辞だったようなので、当初は、Common Lispでいうとread:from-stringみたいな感じだったのかもしれません。
しかし、これらの接頭辞は、その後パッケージができても名前はそのまま変更されることもなく後の慣習と混ざり、なんとなく命名規約が二重になった感じを残したようです。

また、現在のLispでは単語を-で繋ぎますが、一部_で繋いだものも存在したようです。これらは後に-で統一されます。

%は現在の命名慣習でも公でない内部関数を表わしたりしますが、初期のLisp Machine Lispでもそのようです。
この後、CADR時代になってくると、マイクロコードで書かれた低レイヤーのサブプリミティブで値を返すことが前提になっていないものに%が付くという慣習になって行ったようです。

%が重なる%%の命名規約は謎です。安直に考えると、さらに内部の関数という感じですが、どうもそうでもない雰囲気があります。

面白いのが、下請けを意味する*と併用されたりすることで、例えば、%*NCONCは、可変長のNCONCの二引数版でかつ公でない関数、という感じになります。また、%*GENSYM-COUNTERのように変数に適用されることもあるようです。

• 7.x PREFIX REGISTRY

TRACE-
GRIND-
TV-
PC-PPR-
KBD-
FILE-
PRINT-
READ-
FASL-
ED-
ED-COM-
%
%%
*
%*
DTP-
%%Q-
CDR-
%%AREA-MODE-
FSM-
%SYS-COM-
ADI-
%%ADI-
LP-
%%LP-
%%ARG-DESC-
%FEF-
%%FEF-
FEF-
%%ARRAY-
%ARRAY-
ARRAY-
ART-
FEFH-
%FEFH-
%%FEFH-
FEFHI-
%%FEFHI-
%%PHT1-
%%PHT2-
%PHT-
SG-
%%SG-
MESA-
%%MESA-

むすび

CONS時代のLispがどのようなものだったかの資料は少なく、AIM-444: LISP Machine Progress Reportに書いてあることも謎が多かったのですが、このマニュアルで若干謎が解明されました。
また、Lisp Machine LispはCADRから始まるような印象がありましたが、初期のものを含めると1975、6年あたりから存在するといえそうです。

■

HTML generated by 3bmd in LispWorks 7.0.0

Lispな人でマストドンを利用している人がどれだけいるのかは分からないのですが、ボットを作成するのが簡単だったので、Twitterボットが投稿するついでにマストドンにも投稿するようにしてみました。

r/lisp_jaと、その他英語Lisp系サブレディットの詰め合わせ版の二種があります。

• r/lisp_ja (@reddit_lisp_ja) - mstdn.jp
• r/lisp (@reddit_lisp) - mstdn.jp

TLのお供にどうぞ。

ちなみに、Twitterはこちらです。

• reddit_lisp_ja(@reddit_lisp_ja) | Twitter

• reddit_lisp_ja(@reddit_lisp) | Twitter

■

HTML generated by 3bmd in LispWorks 7.0.0

失敗とは呼びたくないんですが、Common Lispのformatとかloopマクロとか、絶対誰も真似しないだろうから、誰か真似してほしい

— 淡中☆圏 (@tannakaken) 2018年3月26日

実際の所、LOOPやFORMATはCommon Lispを使ったことがない人達にも複雑さの象徴のように語られていますが、割合にCommon Lisp以外にも輸出されています。
どちらもライブラリレベルの機能なので導入も難しくはありません。

言語仕様に入っているかどうか、ということならば、いまどきはライブラリレベルで実現できるものは言語のコアに入れず、標準ライブラリ位にまとめる所をCommon Lispでは全部標準仕様内にまとまった構成になっている、という点が特徴ですが、言語設計でそういう選択をしたので、こうなっています。
また、LOOPやFORMATはCommon Lisp以前から存在しますが、Common Lispより前のLispではライブラリとして導入されています。

コアに入っているかどうかということになると、LOOPはPython等の内包表記と機能的にはほぼ変わらないもので、ある意味先祖的なものに感じます。
内包表記の難解さに対する批評がありますがLOOPへの批評も似たものがあります(前置 vs 中置の議論の他に)

FORMATも繰り返しがあったりする所が珍しいですが、繰り返し以外では、いまどきの言語に似たようなものは多数ありますし、より多機能なものも多いです。

ちなみに、LOOPやFORMATよりいまどきの言語が標準搭載している正規表現エンジンの方が複雑だと思いますが、正規表現エンジンはCommon Lispでは標準規格にはないので、みなライブラリを利用しています。

ライブラリレベルで移植されたLOOPやFORMAT

ライブラリレベルで移植された例をざっと挙げてみましょう。

LOOP

INTERLISPのclispという環境があり、そこで中置的に書ける構文のforがMACLISP系Lispに取り入れられました。 主にMIT Lispマシングループで良く使われ、今に至ります。

Common LispのLOOPでできることは殆どINTERLISPのforで可能なのでLOOP自体が「誰かが真似したもの」でした

Common Lisp以外に移植された例

Scheme

• The CHICKEN Scheme Eggs: loop

Emacs Lisp

• Loop Facility - Common Lisp Extensions

Clojure

• GitHub - tayssir/cl-loop: Common Lisp style loops in Clojure

等々、多数あります。

全部乗せな繰り返し構文というLOOPと似たコンセプトのものだとsrfi-42を筆頭に多数あります。

• SRFI 42: Eager Comprehensions

また、Common Lisp内でもLOOP代替構文というのは多数あります。

FORMAT

FORMATの出自

FORTRANのFORMATをMACLISPに導入したのが始まりのようです。

Clojure

• cl-format - clojure

Scheme

• format - The CHICKEN Scheme wiki

Emacs Lisp

• GitHub - alvinfrancis/cl-format: CL format routine

全部乗せな出力構文というFORMATと似たコンセプトのものだとfmtを筆頭に結構あります。

• Combinator Formatting:fmt

むすび

実際の所、FORMATやLOOPは大したものでもなく、フルスペックでも大体1000行前後の実装が多いので、ひまつぶしのログラミングの題材には丁度良いと思います。

■

HTML generated by 3bmd in LispWorks 7.0.0

• 時の羅針盤＠blog: Generatorの勧め

ClojureにTransducers、SchemeにGenerator(SRFI-158/SRFI-121)だそうですが、Common Lispだったらseriesでしょう、ということでCommon Lisp版を書いてみました。

target1が「リスト生成→フィルタリング」、target2が「ジェネレータを使ってストリーム的に処理」するので中間コンスが少なくできる、という内容です。

今回の場合は、そっくりそのままCommon Lisp+seriesで写しとれる感じです。

下準備

;;; scheme
(define size 1000)

;;; cl
(ql:quickload :series)
(defpackage gen 
  (:use :cl :series))
(in-package :gen)
(defconstant size 1000)

target1

;;; scheme
(define (target1)
  (filter (lambda (x) (zero? (mod x 3)))
          (map cdr
               (filter (lambda (x) (odd? (car x)))
                       (map (lambda (x) (cons x (square x)))
                            (iota size))))))

;;; cl
(defun target1 ()
  (remove-if-not (lambda (x) (zerop (mod x 3)))
                 (mapcar #'cdr
                         (remove-if-not (lambda (x) (oddp (car x)))
                                        (mapcar (lambda (x) (cons x (expt x 2)))
                                                (loop :for i :from 0 :repeat size :collect i))))))

target2

(define (target2)
  (generator->list
   (gfilter (lambda (x) (zero? (mod x 3)))
            (gmap cdr
                  (gfilter (lambda (x) (odd? (car x)))
                           (gmap (lambda (x) (cons x (square x)))
                                 (make-iota-generator size)))))))

(defun target2 ()
  (collect 
   (choose-if (lambda (x) (zerop (mod x 3)))
              (map-fn t
                      #'cdr
                      (choose-if (lambda (x) (oddp (car x)))
                                 (map-fn t
                                         (lambda (x) (cons x (expt x 2)))
                                         (scan-range :length size)))))))

target2はseriesのリーダーマクロを使えばこんな感じにも書けます。
seriesを使うならこっちが普通かもしれません。

(series::install)

(defun target2/ ()
  (collect 
   (choose-if (lambda (x) (zerop (mod x 3)))
              (#Mcdr (choose-if (lambda (x) (oddp (car x)))
                                (#M(lambda (x) (cons x (expt x 2)))
                                   (scan-range :length size)))))))

implicit-mapを有効にすれば、更に簡潔に書けますが、ソースの字面で若干混乱しそうになるのでお勧めはしません :)

(series::install :implicit-map T)

(defun target2// ()
  (collect 
   (choose-if (lambda (x) (zerop (mod x 3)))
              (cdr (choose-if (lambda (x) (oddp (car x)))
                              ((lambda (x) (cons x (expt x 2)))
                               (scan-range :length size)))))))

target3

ついでにdo職人による極力コンスを排したコードも参加してみます。

(defun target3 ()
  (do* ((x 0 (1+ x))
        (y (expt x 2) (expt x 2))
        (ans (list nil))
        (tem ans))
       ((= size x)
        (cdr ans))
    (when (and (oddp x) (zerop (mod y 3)))
      (setf (cdr tem)
            (setq tem (list y))))))

比較結果

今回はタイムというより無駄なコンスを減らすことができるかがポイントのようです。
なお回数は一万回に増やしてみました。

(defparameter *count* 10000)
(equal (target1) (target2))
→ T
(time 
 (dotimes (i *count*)
   (target1)))
#||
Timing the evaluation of (dotimes (i *count*) (target1))
User time    =        0.521
System time  =        0.000
Elapsed time =        0.508
Allocation   = 678292704 bytes
0 Page faults
Calls to %EVAL    160036
||#
(time 
 (dotimes (i *count*)
   (target2)))
#||
Timing the evaluation of (dotimes (i *count*) (target2))
User time    =        0.236
System time  =        0.000
Elapsed time =        0.226
Allocation   = 198294392 bytes
0 Page faults
Calls to %EVAL    160036
||#

seriesを使ったtarget2方がコンスはtarget1の約29%に縮減し、タイムも倍速くなりました。
(ちなみに、srfi-158では67%の縮減のようです。)

vs do 職人コード

do 職人のtarget3とも比較してみます。

target2と速度はあまり変わりませんが、コンスはさらに縮減できてtarget1の約5%になりました。

(equal (target1) (target3))
→ T
(time 
 (dotimes (i *count*)
   (target3)))
#||
Timing the evaluation of (dotimes (i *count*) (target3))
User time    =        0.213
System time  =        0.000
Elapsed time =        0.203
Allocation   = 38295784 bytes
0 Page faults
Calls to %EVAL    160036
||#

といっても、途中でnとn^2のペア作ってないし卑怯!となってしまうと思うので、中間でペアを作りつつdo職人の結果を目指します。

seriesはストリーム的な書法の他に外部イテレータ的な書き方も可能で、下記のように書いてみました。

なぜこう書くかというと、ペアを作ってペアをばらすのを同一のスコープに収めてdynamic-extent指定し、コンスは無かったことにしたいからで、標準APIのストリーム的な書法ではちょっと難しいです。
(多分ストリームを二本作れば可能)
なおdynamic-extent指定をしなくても多値を使って同様の効果が得られます(がペアを作る縛りなので……)

計測してみると、do職人コードと遜色なくなりました。

(defun target4 ()
  (let ((g (gatherer #'collect)))
    (iterate ((x (scan-range :length size)))
      (let ((x (cons x (expt x 2))))
        (declare (dynamic-extent x))
        (when (oddp (car x))
          (let ((x (cdr x)))
            (when (zerop (mod x 3))
              (next-out g x))))))
    (result-of g)))

(equal (target1) (target4))
→ T
(time 
 (dotimes (i *count*)
   (target4)))
#|||
Timing the evaluation of (dotimes (i *count*) (target4))
User time    =        0.232
System time  =        0.000
Elapsed time =        0.220
Allocation   = 38939848 bytes
0 Page faults
Calls to %EVAL    160036
||#

ちなみに、dynamic-extent指定を削除するとコンスはtarget1並みに増えるようです。

#||
Timing the evaluation of (dotimes (i *count*) (target4))
User time    =        0.244
System time  =        0.000
Elapsed time =        0.231
Allocation   = 198940456 bytes
0 Page faults
Calls to %EVAL    160036
||#

まとめ

遅延リスト、ストリーム、ジェネレータ辺りで何かしようと思ったらseriesも結構使えることがあります。

ただseriesは色々特殊なので、もうちょっと整理された次世代seriesがあったら良いなあという近頃です。

■

HTML generated by 3bmd in LispWorks 7.0.0

久々にonjoさんのページを眺めていて、どう書く？orgの問題を解いているページに遭遇しました。

• ローカル変数の一覧を取得 @ どう書く？.org — LISPUSER

かれこれ10年以上前のことですが、そういえばこんな問題あったなあと懐しくなりました。
下記のような問題です。

どう書く？org: ローカル変数の一覧を取得

”

リフレクション系のお題の続編です。 ローカル変数の内容を取得して連想配列(ハッシュ、辞書など)に詰める コードを書いてください。
Pythonで表現すると、下のコードの???部分を埋めることになります。
>>> def foo():
    x = 1
    y = "hello"
    ???
    return result
>>> foo()
{'y': 'hello', 'x': 1}

”

なお、どう書く？orgは残念ながらアダルトサイトと化してしまったようなのでリンクはarchive.orgです。

Lisp方言の他の方々の回答は、基本構文に仕込みを入れて、Pythonでいうlocalsみたいなものをサポート、という感じです。
自分は、この問題は解いたことがなかったので、色々考えてみました。

Common Lispにおいてローカル変数とは

お題はPythonが念頭にあるようですが、Lisp-1なPythonならローカルのスコープに漂っているのは変数位のものです。
しかし、Lisp-2の権化たるCommon Lispだと、関数、マクロ、シンボルマクロ、スペシャル変数等々がローカルスコープに存在しうります。

実際的にコードウォーキングして何かをする場合、ブロック、GOタグ等を含めていじること多いので、変数だけ取得できても、そんなに嬉しくない気はしますが、それはさておき解答を考えてみます。

解答その一 (実際的に考える)

実際の所、実行時にスコープ内のローカル変数名の一覧を取得したいことというのは殆どありません。
また、遅くなっても良いのだったら、別に言語のスコープのコンテクストをいじらなくても、連想配列等でエミュレートできそうです。

とりあえず、Common Lispには、実行時に名前で変数をアクセスする仕組みとしてスペシャル変数があるので、そういう時はスペシャル変数を使うのが良いだろうということで、こんな感じに書いてみました。

(defun locals () nil)
(defmacro progx ((&rest binds) &body body)
  `(progv ',(mapcar #'car binds)
       (list ,@(mapcar #'cadr binds))
     (flet ((locals ()
              (append (list ,@(mapcar (lambda (b)
                                        `(cons (quote ,(car b))
                                               ,(cadr b)))
                                      binds))
                      (locals))))
       ,@body)))

(defun foo (&aux result)
  (progx ((outer 42))
    (progx ((x 1)
            (y "hello"))
      (setq result (locals))
      result)))
(foo)
→ ((x . 1) (y . "hello") (outer . 42)) 

上記のprogxは、実行時の変数結合を実現するprogvをラップしたもので、ボディ内部のlocalsの実行で指定された変数名が取得できます。

スペシャル変数のアクセスはそこまで遅くないので、もし実際的に必要なことがあれば、こういうものでまかなえるのではないでしょうか。

その二 (定義時に処理する)

onjoさんの解答がこちらの系統ですが、onjoさんはAllegro CLのインタプリタ動作時のみ対応とのことでした。
しかし、実行時に外から飛び込んでくるレキシカル変数名というのは考慮しなくても良さそうなのと、外から飛び込んでくるスペシャル変数名は、上記progxのようなもので別途対応すれば良いだろうということで、定義時(マクロ展開時)に確定した情報を取得できれば良しという方針でシンプルに書いてみました。

#+lispworks
(defun get-local-variables (env)
  (mapcar #'compiler::venv-name (compiler::environment-venv env)))
#+sbcl
(defun get-local-variables (env)
  (mapcar #'car (sb-c::lexenv-vars env)))
#+allegro
(defun get-local-variables (env)
  (let* ((base (sys::augmentable-compilation-environment-base env))
         #+(:version= 8)
         (vartab (sys::augmentable-environment-variable-hashtable base))
         #+(:version>= 9)
         (vartab (sys::ha$h-table-ht
                  (sys::augmentable-environment-variable-hashtable base))))
    (loop :for var :being :the :hash-keys :of vartab
          :when (typep (sys:variable-information var env)
                       '(member :lexical :special))
            :collect var)))
(defmacro locals (&environment env)
  `(list ,@(mapcar (lambda (v)
                     `(list ',v ,v))
                   (get-local-variables env))))

肝は、ローカル変数の一覧が取れるかどうかなのですが、Clozure CLでは取得の方法が分からず対応していません。
ローカル変数の一覧が取れる処理系であれば同様の方法で取得できるかなと思います。

試してみる

こんな感じになります。

(defun foo (&aux result)
  (let ((outer 42))
    (declare (special outer))
    (flet ((bar ()
             (let ((x 1)
                   (y "hello"))
               (setq result (locals))
               result)))
      (bar))))
→ ((y "hello") (x 1) (outer 42) (result nil))

また、変数は宣言してから使うことになるので、Pythonと違ってresultも計上されることになりますし、ローカル変数外側のスコープものも見えます。

ちなみに、Pythonで確認してみたところ、外のブロックのものは取得しない様子。

def foo():
  outer = 42
  def bar():
    x = 1
    y = "hello"
    result = locals()
    return result
  return bar()
→ {'y': 'hello', 'x': 1}

しかし、一番内側のブロックで変数を使えば見えるようです。
どうも、中途半端なような。

def foo():
  outer = 42
  def bar():
    x = 1
    y = "hello"
    z = outer
    result = locals()
    return result
  return bar()
→ {'y': 'hello', 'x': 1, 'z': 42, 'outer': 42}

まとめ

どう書くorgのページでも議論されていましたが、処理系がデバッグ情報として変数名を含める際にこういう機能が必要になることが多いと思われますが、ユーザーが触って何か有益な処理をするというのはあまり無さそうです。

なお、ご存知の通り、Common Lispでは対話的なデバッガの機能が充実しているので、ローカルな変数名等は大抵見えたり、変更したりもできます。

■

HTML generated by 3bmd in LispWorks 7.0.0

こんにちはCommon Lispポリスメンです。

最近だいぶ忘れられてきてる気がするけど、rmsは Common Lisp の言語仕様をとりまとめた主要4人のうちの一人で、GNUをプロジェクト立ち上げて GNU emacs と gcc と gdb の最初のバージョンを全部一人で書いた偉人ですからね…

— SODA Noriyuki (@n_soda) 2018年3月9日

RMSはとても偉大ですが、Common Lisp仕様の議論には参加してるものの、主要人物ではありませんでした。
ちなみにCommon Lisp仕様の議論には何十人もの人が参加しています。
また、主要人物は4人ではなく、5人でした。

• The Evolution of Lisp

  The core group eventually became the “authors” of CLtL I: Guy Steele, Scott Fahlman, David Moon, Daniel Weinreb, and Richard Gabriel. This group shouldered the responsibility for producing the language specification document and conducting its review. The self-adopted name for the group was the “Quinquevirate” or, more informally, the “Gang of Five”.

また、ANSI Common Lisp規格策定のX3J13のメンバーでもありません。

おそらくですが、RMSとGLSが混ざってしまったのではないでしょうか(LispとEmacsあたりで)
RMSが議論に参加している様子は、仕様策定メーリングリストで眺めることができますので、ご興味があればどうぞ。

• common-lisp at su-ai

また、Common Lisp(1984)の謝辞にも登場しています。

• Acknowledgments

その他おまけ

• Symbolicsと闘っていた頃のRMSのLispコード

RMSが書いたっぽいLispコードの例

• コードウォーカー:qcluke.lisp
• FORMAT代替ユーティリティ:output.lisp(開発動機はFORMATがLispっぽくないから)

■

HTML generated by 3bmd in LispWorks 7.0.0

先日Twitterでこんなやりとりを目にしました

ところがどっこいLisp

— わさびず (@___yuni) 2018年3月2日

たしかに太古のMACLISPや、Franz Lispでは、変数の結合がダイナミックだったりして、コンパイラ(静的に決まることが多かった)かインタプリタ(基本動的)かで挙動が変わることが悩みのタネだったことがありました。

しかし……Common Lispではコンパイラかインタプリタ実装かで実行に差異はない

はい、残念ながらeval-whenというのがあって、コンパイラとインタプリタが存在して違う操作的意味を持つことが前提になってます

— わさびず (@___yuni) 2018年3月2日

eval-whenというからにはLispが指しているのはCommon Lispだと思いますが、Common Lispでは、評価器がコンパイラかインタプリタ実装かで違いはでないこと、と規定されています。
また、プログラムがどちらの方式で実行されているか知る手立てもありません。

• evaluation

evaluation n. a model whereby forms are executed , returning zero or more values.
Such execution might be implemented directly in one step by an interpreter or in two
steps by first compiling the form and then executing the compiled code; this choice is
dependent both on context and the nature of the implementation, but in any case is
not in general detectable by any program. The evaluation model is designed in such a
way that a conforming implementation might legitimately have only a compiler and
no interpreter, or vice versa. See Section 3.1.2 (The Evaluation Model).

Common Lispがするコンパイルと実装戦略は別

じゃあ、Common Lispのcompileとかcompile-fileはどうなるんだ、と思うかもしれないですが、Common Lispが規定するコンパイルプロセスは、評価器の実装戦略とは別のレイヤーの話です。

以下、ややこしいのでコンパイルプロセスの方をコンパイルと書きます。
Minimal Compilationというのが定められていますが、インタプリタのみの処理系でも、コンパイルしてロードして、というのは可能で、その場合にはコンパイルによってマクロ展開等の前処理的なものを省いたものを解釈していくことになると思われます(多分)

また逆に、evalが即ちインタプリタということもなく、フォームの一塊のツリーをコンパイルしてから処理しても問題ありません。

• 3.2.2.2 Minimal Compilation

Minimal compilation is defined as follows:
• All compiler macro calls appearing in the source code being compiled are expanded, if at
all, at compile time; they will not be expanded at run time.
• All macro and symbol macro calls appearing in the source code being compiled are
expanded at compile time in such a way that they will not be expanded again at run
time. macrolet and symbol-macrolet are effectively replaced by forms corresponding to
their bodies in which calls to macros are replaced by their expansions.
• The first argument in a load-time-value form in source code processed by compile
is evaluated at compile time; in source code processed by compile-file , the compiler
arranges for it to be evaluated at load time. In either case, the result of the evaluation is
remembered and used later as the value of the load-time-value form at execution time.

eval-whenとは

eval-whenは、主に処理が複数に分かれてしまう(ファイルをコンパイルしてロードする等)場合に生じる問題を解消するためのもので、コンパイル中にコンパイル中に定義した関数を使いたいとか、コンパイル済みのファイルをロードする場合に特定の仕事をさせたい等々のことに利用します。

あーーーーそうかーーーー（Emacs Lispの eval-when-compile は認識してたなあ）

— gfn (@bd_gfngfn) 2018年3月2日

Emacs Lispのeval-when-compileも似たようなものだと思いますが、脚注のコメントによると、Common Lispの#.(リード時評価)により近いそうです。

• GNU Emacs Reference Manual: 16.5 Evaluation During Compilation

用途としてはCommon Lispと同じではないでしょうか。インタプリタ実装でもコンパイルは可能なので、Emacs Lispは、100%インタプリタ実装のCommon Lispに近い感じなのかもしれません。

他の方々からの指摘

うーん、そうなのかなー？eval-whenの使いどころは分からないけど、Common Lispはインタープリタかコンパイラかは言語仕様的には規定しないって明示されていた気がする。例えば、即座にコンパイルしてインタープリタを持たない実装もOKなはず

— Miura Hideki (@miura1729) 2018年3月3日

上記で説明したように、挙動は変わないことになっています。

なるほど、意味が分かりました。eval-whenでコンパイル時に何か行えば実装がコンパイラかインタープリタかで挙動を変えることが出来るから同一セマンティクスじゃなくなりますね。すっきりしました、ありがとうございます。

— Miura Hideki (@miura1729) 2018年3月3日

上記で説明したように、eval-whenと実装戦略は別のレイヤーで、これらの組み合わせがコードの意味を変えることはありません。

まとめ

Common Lispではコンパイラかインタプリタ実装かで実行に差異はない、と書きましたが、これは過去のLispでの問題を解決する歴史の上に成り立ったものでした。
Common Lispの歴史の中でも、ANSI規格以前のCLtL1では、*applyhook*、*evalhook*、compiler-let等、コンパイラ/インタプリタ動作で整合性が取れなくなる/取るのが難しい機能が散見されましたが、これらはANSI規格として煮詰められる際に廃止となっていたりします。

また、現代のCSの意味論からすると不思議なこともあると思いますが、CSの意味論が洗練/確立する前からLispのコンパイラ/インタプリタは存在します。
長い歴史の中で、互いに影響しあったかもしれませんし、同じような結果になったとしても道程は全然違うものかもしれません。

コンパイラ……インタプリタ……コンパイラがコンパイル……と書いてる間に段々良く分からなくなってきたので、間違いがあったらご指摘よろしくお願いします。

ちなみに何故Twitterの議論には参加していないのかというと、自分は鍵アカウントの為で、ブログで失礼しました。

■

HTML generated by 3bmd in LispWorks 7.0.0

On Lispの10.3 マクロ展開関数の副作用には、

MillerとBensonのLisp Style and Designは 展開コードの副作用から起きる問題の特別に汚い例に言及している． Common Lispでは...

とあります。
恐らく、「特別に汚い例に言及している．」の後は、Lisp Style and Designが言及している内容を具体的に紹介しているのだとは思いますが、いまいち文の繋がりが良くなく思え、言及しているという紹介のみで、以降は全く別の話という可能性も無くはないと思えてきてしまったので、実際にLisp Style and Designでは何が書かれていたのか確認してみました。

ネタ元

Lisp Style and Designでは、マクロの展開時の問題について解説していますが、恐らく、4.2.5.2 Problems to Avoid When Writing Macros(P.85)のようです。

この段落では、主にマクロ展開時に副作用を使うと、どういう悪い結果が齎されるかについて、具体例を挙げて解説していますが、締めに&rest・&bodyのリストの破壊的変更が解説されています。

ということで、On Lisp 10.3章の「言及している」から章末までは、Lisp Style and Designでの解説を元ネタにしてます、ということだったようです。

ちなみに、On Lisp 10.3章では、副作用の例として、マクロ展開時に変数を更新することについてを取り上げていますが、Lisp Style and Designでは、変数のspecial宣言を取り上げていて、On Lispでinternの問題が追加になった以外は、両書ともほぼ同じ問題を紹介していたようです。

■

HTML generated by 3bmd in LispWorks 7.0.0

コンパイラマクロは関数だけでなくマクロにも定義できます。
HyperSpecのdefine-compiler-macroの項目にも明記されているのですが、一体どういう所で使うのかと思っていました。

コンパイラマクロの使い方としては、基本的にセマンティクスが変わらないことが絶対条件で、あとは何らかの効率が良くなるようなコード変換をすることになるんだと思います。
マクロでこういうパターンはどういう場合かを考えてみましたが、TAOのforみたいな場合に効率的な処理に展開できそうなので、ちょっと試してみました。

なお、マクロにコンパイラマクロを定義して、マクロなのにfuncallが効くように見せ掛けるテクニックを目にしたことがありますが、これはセマンティクスが変わってしまうのでNGかなと思っています。

TAOのfor

TAOのマニュアルによると、forは、

  形式 : for var list form1 form2  ...
form1 form2 ... を var を使って順に実行する。 var は list の各要素に
逐次束縛されたものである。 form1 form2 ... は list の長さと同じ回数評価
される。 nil を返す。

とあって殆どdolistと同じ挙動なのですが、indexというSRFI-1のiotaのような関数と組み合せて使う場合、実際には数値リストが生成されないという説明があります。

(index 0 10)
→ (0 1 2 3 4 5 6 7 8 9 10) 
(let ((ans nil))
  (for i (index 0 10) (push i ans))
  ans)
→ (10 9 8 7 6 5 4 3 2 1 0) 

恐らく実際のTAOもマクロ展開のパターンマッチで展開を変えているんだと思いますが、こういうケースのマクロ展開にコンパイラマクロが使えそうです。

とりあえず、ベースの関数とマクロを定義します。

(defun index (start end &optional (step 1))
  (if (plusp step)
      (loop :for i :from start :upto end :by step :collect i)
      (loop :for i :from start :downto end :by (- step) :collect i)))
(defmacro for (var list &body body)
  `(dolist (,var ,list nil)
     ,@body))

コンパイラマクロで中間リストの生成を無くす

そしてコンパイラマクロを定義します。

下記では、無駄にメソッドを使っていますが、こういう場合には嵌るかなと思って試してみました。
メソッドディスパッチでindexだけでなく、iotaにも対応してみています。

(define-compiler-macro for (&whole whole var list &body body)
  (for-cm-expander (car list) var list body whole))
(defgeneric for-cm-expander (fn var list body whole)
  (:method (fn var list body whole) 
   (declare (ignore fn var list body))
   whole))
(defmethod for-cm-expander ((fn (eql 'index)) var list body whole)
  (declare (ignore whole))
  (destructuring-bind (index start end &optional (step 1 stepp))
                      list
    (declare (ignore index))
    (if stepp
        `(if (plusp ,step)
             (loop :for ,var :from ,start :upto ,end :by ,step
                   :do (progn ,@body))
             (loop :for ,var :from ,start :downto ,end :by (- ,step)
                   :do (progn ,@body)))
        `(loop :for ,var :from ,start :upto ,end
               :do (progn ,@body)))))
(defmethod for-cm-expander ((fn (eql 'srfi-1:iota)) var list body whole)
  (declare (ignore whole))
  (destructuring-bind (iota count &optional (start 0) (step 1))
                      list
    (declare (ignore iota))
    `(loop :for ,var :from ,start :repeat ,count :by ,step
           :do (progn ,@body))))

こういう定義にすると、コンパイル時にはこういう展開になります。

(compiler-macroexpand '(for i (index 10 20) (print i)))
==>
(loop :for i :from 10 :upto 20 :do (progn (print i))) 
(compiler-macroexpand '(for i (srfi-1:iota 10) (print i)))
==>
(loop :for i :from 0 :repeat 10 :by 1 :do (progn (print i))) 

決め打ちのパターンから外れれば、リストを回す通常の処理になります。

(compiler-macroexpand '(for i (cons -1 (index 0 10)) (print i)))
==>
(for i (cons -1 (index 0 10)) (print i)) 

むすび

define-compiler-macroでマクロにコンパイラマクロを定義できるようにした経緯からユースケースを知りたかったのですが、過去のメーリングリスト等からは探し出せませんでした。

何か他のユースケースがあれば是非とも知りたいです。

■

HTML generated by 3bmd in LispWorks 7.0.0

LispWorks 7.1を試用していて2件程バグっぽい挙動に遭遇していました。
折角試用させて貰ったので、何かバグ的なものは報告しておきたいところなので期間最終日に報告。

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

具体的な再現コードにすると

(defun foo (x) x . a)
→ foo
(compile nil (lambda (x) x . a))
→  #<Function 15 406003A054> 
    NIL 
    NIL

というのが通ってしまいます。
LW 7.0では、 In a call to length of (x . a), tail a is not a LIST.

というエラーになりますが、LispWorks以外の大抵の処理系も同様のエラーとします。
7.1では、点対リストを許容するようになったのかとも思えますが、

(compile nil (lambda (x) . a))
→ Cannot take CDR of A.

こういうのは通らないので一貫性がない様子。

UTF-8のエンコーディング設定で起動時にエラーになる

もう一点、LispWorks 7.0を利用していてバグじゃないかと思いつつも適当なワークアラウンドで回避できていたのですっかり忘れていたことがありました。
具体的には、UTF-8の設定時に起動でコケるというちょっと嫌な感じのもの。

どうやらバイナリのファイル(スプラッシュ画像)をUTF-8で開こうとしてエラーになるらしいので、ファイルのエンコーディング判定関数で画像ファイルは迂回するようにしていましたが、これが7.1でも発生する様子。

;;; 回避コード
(defun utf-8-file-encoding (pathname ef-spec buffer length)
  (declare (ignore buffer length))
  (if (assoc (pathname-type pathname) graphics-ports::*file-types-to-image-types*
             :test #'equalp)
      '(:latin-1)
      (system:merge-ef-specs ef-spec '(:utf-8 :use-replacement t))))
(setq system:*file-encoding-detection-algorithm*
      '(utf-8-file-encoding))

報告を作成するためにちょっと追い掛けてみましたが、capi-gtk-library::put-image-data-in-fileでエラーになるらしいので、この関数のトレース結果を添付しました。

報告してみた

最終日に報告してみたところ、UTF-8の方はバグだったらしく二日後にプライベートパッチが届きました。
なんとパッチが出るとは想定していなかった。試用期間は終了しているのでパッチが試せないという……。

パッチの名前が、put-image-data-in-file.64ufaslなので、やはり報告した、capi-gtk-library::put-image-data-in-fileが問題のようです。

もったいないので、とりあえず駄目元で7.0で読み込ませてみましたが、faslに互換性がないと警告がでるものの、無視して続行可能なので試したら、7.0でも機能するようです。

ちょっと深追いして、パッチ適用前後のcapi-gtk-library::put-image-data-in-fileを比較してみると、修正前のものは、バイナリの一時ファイルを作成するのにsys:make-temp-fileというテキストの一時ファイルを作成する関数を呼んでいたため、エンコーディングの問題が発生していたようです。
修正では、sys:make-temp-fileの下請けであるsys::open-temp-fileを使ってファイルを(unsigned-byte 8)で開くようにした様子。

大抵のユーザーはlatin-1で使っていたから遭遇しなかった問題なのか、なんなのか。
とりあえず、バイナリファイルの開き方が悪かったということで、エンコーディング周りがバグってるわけではない様子なので良かったです。

ちなみに7.0で強制的に読み込ませるのには、

(handler-bind ((fasl-error #'continue))
  (scm:require-private-patch "put-image-data-in-file" :capi-gtk))

としています。

7.0用のパッチが貰えるなら、貰った方が良いのかもしれない。

試しにdisassembleの内容からコードを推測しつつ自作しててみましたが、下記と等価なようです。
(コンパイルオプションを設定すればdisassembleの結果が同じになる)

(in-package :cg-lib)
(declaim (optimize (safety 3)
                   (speed 1)
                   (float 1)
                   (sys:interruptible 0)
                   (compilation-speed 1)
                   (debug 2)
                   (hcl:fixnum-safety 3)))
(defun put-image-data-in-file (image-data)
  (destructuring-bind (file-type . data)
                      image-data
    (let ((out (sys::open-temp-file :file-type file-type
                                    :element-type '(unsigned-byte 8)
                                    :external-format :latin-1)))
      (write-sequence data out)
      (close out)
      (namestring out))))

このコードを

(let ((source-debugging-on-p (source-debugging-on-p)))
  (toggle-source-debugging nil)
  (compile-file "put-image-data-in-file.lisp" :debug-info nil)
  (toggle-source-debugging source-debugging-on-p))

のような感じでコンパイルすれば、大体提供されているパッチファイルと同じになるようです。

LispWorks 7.0のパッチが入手できない場合は、最悪これでも良いかもしれません。

もう一つのボディが点対リストを許容する件については、一週間後位に回答があり、次期バージョンで善処したいということでした。

むすび

試用期間のバグ報告は、パッチが期間内に試せるように早めに報告しよう。

■

HTML generated by 3bmd in LispWorks 7.0.0

LispWorksでは、Enterprise版でしか使えない機能はいくつかありますが、中でも自分はKnowledgeWorksに興味があったので、まずはこれを試してみたいところ。

KnowledgeWorksは、Common Lispで構成された古き良き知識ベースのシステムで、主に後ろ向き推論のPrologと、前向き推論のOPS5が合体したようなシステムです。
1980年代後半から90年代前半の商用のLispシステムでは、エキスパートシステム作成用にOPS5やProlog拡張が付属することが多かったようで、こういう構成は案外定番の構成だった様子。
(ちなみに、Prologの処理系でも前向き推論の拡張等は良く付属していたようです。)

Prolog部分は、Common Prologと呼ばれていて、これ単体でも使えます。
ということで、このブログでは毎度お馴染のZebraベンチを書いてみました。

Common PrologでZebra ベンチ

;;;; -*- Mode: common-lisp; Syntax: Common-Lisp -*-
(declaim (optimize (speed 3) (safety 0) (compilation-speed 0)
                   (debug 0)))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (require "prolog"))
(defpackage :clog-zebra (:use :cl :clog))
(in-package :clog-zebra)
(defrel nextto
  ((nextto ?x ?y ?list) (iright ?x ?y ?list))
  ((nextto ?x ?y ?list) (iright ?y ?x ?list)))
(defrel iright
  ((iright ?left ?right (?left ?right . ?rest)))
  ((iright ?left ?right (?x . ?rest))
   (iright ?left ?right ?rest)))
(defrel zebra
  ((zebra ?h ?w ?z)
   ;; Each house is of the form:
   ;; (house nationality pet cigarette drink house-color)
   (= ?h ((house norwegian ? ? ? ?)   ;1,10
          ?
          (house ? ? ? milk ?) ? ?))  ; 9
   (member (house englishman ? ? ? red) ?h) ; 2
   (member (house spaniard dog ? ? ?) ?h) ; 3
   (member (house ? ? ? coffee green) ?h) ; 4
   (member (house ukrainian ? ? tea ?) ?h) ; 5
   (iright (house ? ? ? ? ivory)      ; 6
           (house ? ? ? ? green) ?h)
   (member (house ? snails winston ? ?) ?h) ; 7
   (member (house ? ? kools ? yellow) ?h) ; 8
   (nextto (house ? ? chesterfield ? ?) ;11
           (house ? fox ? ? ?) ?h)
   (nextto (house ? ? kools ? ?)      ;12
           (house ? horse ? ? ?) ?h)
   (member (house ? ? luckystrike oj ?) ?h) ;13
   (member (house japanese ? parliaments ? ?) ?h) ;14
   (nextto (house norwegian ? ? ? ?)  ;15
           (house ? ? ? ? blue) ?h)
   (member (house ?w ? ? water ?) ?h) ;Q1
   (member (house ?z zebra ? ? ?) ?h) ;Q2
   ))
;; (logic '(zebra ?h ?w ?z) :return-type :fill)

(defun zebra-benchmark (&optional (n 1000))
  (declare (optimize (speed 3) (safety 0)))
  (let (rt0 rt1)
    (time (loop initially (setf rt0 (get-internal-run-time))
                repeat n do (logic '(zebra ?h ?w ?z) :return-type :fill)
                finally (setf rt1 (get-internal-run-time))))
    (destructuring-bind (houses water-drinker zebra-owner)
                        (logic '(zebra ?houses ?water-drinker ?zebra-owner)
                               :return-type :bag
                               :bag-exp '(?houses ?water-drinker ?zebra-owner))
      (values (/ (* n 12825) (/ (- rt1 rt0) 1000.0)) ; real time 
                                                     ; is milliseconds
              zebra-owner water-drinker houses))))

CL-USER 1 > (clog-zebra::zebra-benchmark)
Timing the evaluation of (LOOP CLOG-ZEBRA::INITIALLY (SETF CLOG-ZEBRA::RT0 (GET-INTERNAL-RUN-TIME)) COMMON-PROLOG:REPEAT CLOG-ZEBRA::N DO (COMMON-PROLOG:LOGIC (QUOTE (CLOG-ZEBRA::ZEBRA CLOG-ZEBRA::?H CLOG-ZEBRA::?W CLOG-ZEBRA::?Z)) :RETURN-TYPE :FILL) CLOG-ZEBRA::FINALLY (SETF CLOG-ZEBRA::RT1 (GET-INTERNAL-RUN-TIME)))
User time    =        2.888
System time  =        0.000
Elapsed time =        2.868
Allocation   = 447980280 bytes
0 Page faults
4440789.5
CLOG-ZEBRA::JAPANESE
CLOG-ZEBRA::NORWEGIAN
((CLOG-ZEBRA::HOUSE CLOG-ZEBRA::NORWEGIAN CLOG-ZEBRA::FOX CLOG-ZEBRA::KOOLS CLOG-ZEBRA::WATER CLOG-ZEBRA::YELLOW) (CLOG-ZEBRA::HOUSE CLOG-ZEBRA::UKRAINIAN CLOG-ZEBRA::HORSE CLOG-ZEBRA::CHESTERFIELD CLOG-ZEBRA::TEA CLOG-ZEBRA::BLUE) (CLOG-ZEBRA::HOUSE CLOG-ZEBRA::ENGLISHMAN CLOG-ZEBRA::SNAILS CLOG-ZEBRA::WINSTON CLOG-ZEBRA::MILK CLOG-ZEBRA::RED) (CLOG-ZEBRA::HOUSE CLOG-ZEBRA::SPANIARD CLOG-ZEBRA::DOG CLOG-ZEBRA::LUCKYSTRIKE CLOG-ZEBRA::OJ CLOG-ZEBRA::IVORY) (CLOG-ZEBRA::HOUSE CLOG-ZEBRA::JAPANESE CLOG-ZEBRA::ZEBRA CLOG-ZEBRA::PARLIAMENTS CLOG-ZEBRA::COFFEE CLOG-ZEBRA::GREEN))

以前、Common Lispの埋め込みPrologを試してみる: Zebraベンチ篇で、ベンチ対決した結果と並べるとこんな感じです。

むすび

PAIPrologの約6倍速く、Allegro Prologの3.4倍遅く、最速のAZ-Prologからは約4倍遅いという結果になりました。
Allegro Prologが謎の速さをみせていますが、Common Prolog(KnowledeWorks)は多機能で、開発環境もリッチですし、全体的なバランスとしては、なかなか良いのではと感じています。

関連エントリー

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

昨年末の11月13日、LispWorks 7.1が発表されました。
LispWorks 7.0が2015-05-05の発表だったので、約二年半ぶりのバージョンアップです。

LispWorks 7.0を使い始めて二年ちょっと経過しましたが、毎日使っているとはいえ、あまり使い倒した感もないため、このまま7.0で行くか、とりあえず、7.1に上げるか悩ましい所ですが、一ヶ月試用できるサービスがあるので、出てすぐの11月17日に試用を申し込んでみることにしました。

お察しの通り、もうとっくに試用期間も終わってしまっているのですが、7.1について何一つブログに書いていなかったので何回かに分けて書いてみます。

試用の申し込み

試用については、二年前のエントリーと全く同じ手順でしたが、既存ユーザーだからか毎度ありがとうというような返事が来ました。

• LispWorks 7購入への道(1)

前回は、HobbyistDVでの試用でしたが、今回は、折角なので、HobbiestとEnterpriseの二種で申し込んでみました。

格が違うとはいえ、ライセンスキーが違うのみで、配布されているファイルは全バージョン共通のようです。

ライセンスキーが届いたので、ファイルをダウンロードし、早速、以前報告したバグがどうなっているか確認してみました。

7.0でのバグは修正されたのか

さて、7.0を使っていて、何度かバグ報告をしてパッチを貰ったりはしていましたが、修正はされているのかが気になりますので、早速確認。

一応、リリースノートには目を通しましたが、そんなに細かいものまで書いてはいないようです。

シンボルのバグ: 修正済み

• LispWorksにバグレポートを出す

7.0では、UTF-8環境で、(eq '資料コード '資料コード) → nilだったりしたので、報告してプライベートパッチを貰ったりしていましたが、治っていました。これは良かった。
しかし、これ7.0で公開パッチ出して欲しかった所ですなあ。

libssl 1.1の読み込みに失敗する: 対応済み

• LispWorks 7.0でlibssl 1.1の読み込みに失敗する

libssl 1.1を読み込ませる場合に明示に指定しないといけない件で問い合わせましたが、次バージョンで対応とのことでした。
リリースノートにもある通り対応されていたので良かったです。

システムの内部関数で型宣言が合ってないものがある: 据置き

• バグ報告: LispWorks/システム関数の型宣言が合ってない

sys::find-external-symbolの型宣言が合ってないのでコンパイルするとエラーになる件でしたが、内部関数は使うな、という回答を貰っていました。
確認した所こちらは据置き。
プロダクション用コンパイルのオプションだと無視しちゃうから気にしてない、とかそういう感じだとは思うけど、いやでも変だと思うんだよなあ。

その2に続く

関連エントリー

• LispWorks 7購入への道(5) ─ 購入
• LispWorks 7購入への道(4) ─ 試用期間の終わりとアンケート回答
• LispWorks 7購入への道(3) ─ Java連携を試す
• LispWorks 7購入への道(2) ─ StumpWMをLWで
• LispWorks 7購入への道(1)

■

HTML generated by 3bmd in LispWorks 7.0.0

立ち上げて早十年の逆引きCommon Lisp/Schemeサイトですが、Shibuya.lisp時代には長期間サイトが落ちていてもなかなか復旧されないため個人のサーバーに移動してみたり転々としています。
先日、再び新しいサーバーに移動することになったので、このタイミングでLispの情報集積サイトである lisphub.jpに移動することにしました。
さらについでで、2010年に立ち上げた Common Lisp Users JP も移動し、若干URLに統一感を持たせる感じで一緒のサイトに設置しました。

• Common Lisp Users JP : http://lisphub.jp/common-lisp/users/
• 逆引きCommon Lisp : http://lisphub.jp/common-lisp/cookbook/
• 逆引きScheme : http://lisphub.jp/scheme/cookbook/

旧URLからは301でリダイレクトされるのでリンクから辿ってくるぶんには使い勝手に変化はありません。

ちなみに、 lisphub.jp ですが、最低10年は保たれるLispのハブサイトを目指して、2013年に立ち上げましたが、広報活動で色々失敗しており、2023年までドメインだけは確保しているという悲しい状況なので今後は活用していきたい所存です……。

• 10年間不動の日本lispコミュニティのハブサイトを作りたい

■

HTML generated by 3bmd in LispWorks 7.0.0

毎年振り返りのまとめを書いていたのですが、ホストしているサーバーの移行をしていて、2017年中に間に合いませんでした。
このブログを配信しているteepeedee2が上手く動かせなかったというのが主な理由ですが、teepeedee2は毎度ながら手強い……。

Lisp的進捗

ブログ

ですます調をやめて、である調にしましたが、どうもしっくり来ないので、今年からはまた、ですます調に戻します……。

である調でも書けるようになってみたかったのですが、どうも過剰に偉そうな雰囲気になってしまうという。

学習

毎年、Advent Calendarで少しだけ無理をして何かを調べて書いていましたが、2017は気力がないのでやめてしまいました。
しかし、やっぱり何かやっておけば良かったなあという思いが残る……。
2018年はがんばりましょう。

LispWorks

LispWorks 7.1が2017年11月に登場し、自分も試用を申し込んで、それなりに7.1の知見は貯まりましたが、全然記事にしていません。
7.0からHobbyist Edition($750)が登場し以前よりは、身近になった気はしますが……。

去年読んでる途中と報告した、LispWorks User Guide and Reference Manualとか、CAPI User Guide and Reference Manualは未だに読み終えていません。

仕様とかマニュアルを読み通すって結構大変なんですよねえ……。 なんかしらちょっとは書きたいと思います。

来年やってみたいこと

昨年の目標であった、

• 積極的にLisp本の積読本を読んで記事にして行きたい
• LispWorksのマニュアル全部を通読したい
• VMS/VAXのエミュレータでVAX LISPを動かしたい
• Lisp組み込み系Prologを系統立てて比較してみたい
• Shenをもうちょっと触りたい
• ヒューイット先生について調べる

は、VAX LISPがライセンスの関係で動かなかったことがはっきりした以外は何も進捗がないですね。
いやあ、時間がない訳では全くないのですが……。

やりたいことは大して変化なしなので、継続としたいと思います。
今年は、もうちょっと活動的になりたいですね。

過去のまとめ

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

■

HTML generated by 3bmd in LispWorks 7.0.0

Lisp Advent Calendar 2017 十三目です。
空きがあったのでネタで埋めようと思い書きました。
十三目書いてたのに!という方は、すいませんが、まだ空きがあるので他の日を埋めてください。

マクロが禁止されたらどうなるの

良くも悪くも誤解が多いLispマクロ。
Lispマクロに心酔するあまり過大評価する人もいれば、過大評価する人をみて過小評価に転ずる人もいる始末ですが、基本的にはコードを生成するだけの機能です。

そんなマクロですが、Common Lispで仮に禁止されたらどうやって生きていったら良いのか考えてみました。
(ちなみに話を簡単にするためにローカルマクロのことは考えないことにします。)

defmacroは何をしているの

Common Lispのdefmacroで定義するものは、リストを引数にして、リストを返すという関数です。
しかし、評価の前に再帰的にマクロを展開するフェイズがあり、そこで展開関数が実行されるので、まるで関数評価のような感じで使うことができます。

例えば、下記のようなコードでloopの展開関数だけ実行することも可能です。

(funcall (macro-function 'loop)
         '(loop :for i :from 0 :repeat 10 :collect i)
         nil)

関数だけでdefmacroのようなことをしてみる

例としてdotimesのようなものを考えてみましょう

'(dotimes (i 10) (princ i))

のようなリストを

'(prog ((#:|limit17589| 10) (i 0))
      "=>"
      (cond ((<= #:|limit17589| i) (return (let ((i nil)) nil))))
      (progn (princ i))
      (incf i)
      (go "=>"))

のようなリストに変形すれば良いので、

(defun mydotimes (form &optional env)
  (declare (ignore env))
  (destructuring-bind (_ (var limit &optional result) &body body)
                      form
    (declare (ignore _))
    (let ((limvar (gensym "limit"))
          (tag (gensym "=>")))
      `(prog ((,limvar ,limit)
              (,var 0))
        ,tag (cond ((<= ,limvar ,var)
                    (return (let ((,var nil)) ,result))))
             (progn ,@body)
             (incf ,var)
             (go ,tag)))))

のような関数を書けるでしょう。
(まあ、結局の所マクロを書く作法が身に付いていないと、こういう関数も書けないのですがそれは一旦忘れましょう)

これで、下記のように書けます。

(with-output-to-string (out)
  (declare (special out))
  (eval (mydotimes 
         `(mydotimes (i 3)
            ,(mydotimes '(mydotimes (j 3) 
                           (princ i out)
                           (princ j out)))))))
→ "000102101112202122" 

やはりマクロ展開と実行コードを混ぜて書かないといけないので、ごちゃごちゃしてしまいます。
別個にマクロ展開関数を用意して、オペレーターが定義したマクロかどうかを確認しつつ展開するようにすれば、

(with-output-to-string (out)
  (declare (special out))
  (mexpand `(mydotimes (i 3)
              (mydotimes (j 3) 
                (princ i out)
                (princ j out)))))
→  "000102101112202122" 

位には圧縮できるかもしれません。

もうちょっと綺麗にできないか

とりあえずは、安直に簡単に見た目を変える方向で、リーダーマクロを使ってごちゃごちゃを隠してみましょう。
見た目がごちゃごちゃしているだけではなく、上記では、変数の結合も実行時にしているので、変数をダイナミック変数に指定していたりします。この辺りもリーダーマクロで読み取り時に展開してしまえば解決です。

なお、リーダーマクロも禁止ならファイルを2パスで処理する等々しかないですね。

(set-syntax-from-char #\] #\))
(set-macro-character 
 #\[ 
 (lambda (s c)
   (declare (ignore c))
   (let ((form (read-delimited-list #\] s T)))
     (funcall (car form) form))))

(with-output-to-string (out)
  [mydotimes (i 3)
    [mydotimes (j 3)
      (princ i out)
      (princ j out)]])
→ "000102101112202122" 

結論

結局の所、

• コードがデータ
• 評価器に渡るコードを変形するフックがユーザーに開放されている

の2点が言語に備わっていれば、Lispマクロのような機能と使い勝手は実現可能だということが分かるでしょうか。
特にLispには限らない筈ですが、使い勝手を含めて真面目に活用が考えられてきた、また実績があるのは、ほぼLisp系言語のみ、というのが現状だと思います。

誕生当初は、LispもM式→S式の変換をして実行するものと考えられていたLispですが、S式というデータの世界にLispプログラマが飛び込んだことが偉大だったのかもしれません。

■

HTML generated by 3bmd in LispWorks 7.1.0

Lisp Advent Calendar 2017 八日目です。
空きがあったのでネタで埋めようと思い書きました。
八日目書いてたのに!という方は、すいませんが、まだ空きがあるので他の日を埋めてください。

括弧が見えなくなったらどうなるの

Emacs等のエディタでは括弧だけ薄い色にしたりできるようですが、Unicodeの幅がない文字で置き換えたらどうでしょうか。

UTF-8のCommon Lispならこんな感じの設定にすればOKでしょう

(progn
  (set-macro-character
   (code-char #x200C)
   (lambda (s c)
     (declare (ignore c))
     (read-delimited-list (code-char #x200D) s T)))
  (set-syntax-from-char (code-char #x200D) #\)))

そうしたら、こう書けます。

‌defun fib ‌n‍
  ‌if ‌< n 2‍
     n
     ‌+ ‌fib ‌1- n‍‍
       ‌fib ‌- n 2‍‍‍‍‍
‌fib 10‍
→ 55

いやあ、読み難いなあ。

エディタに支援してもらおう

Emacsには文字に構文上の意味が持たせられるので、設定しておくと便利かもしれません。

(progn
  (modify-syntax-entry 8204 (format "%c%c" 40 8205))
  (modify-syntax-entry 8205 (format "%c%c" 41 8204)))

これで若干編集が効きますが、どうもあまり上手くいかない。

見えない括弧の応用例

Clojureっぽく書きたい人へ

Clojureは括弧が少ないんだ優勝だという人は、こういう感じはどうでしょうか。

(defun fib (n)
  (cond ‌(< n 2) n‍
        ‌:else (let (‌n1 (1- n)‍
                    ‌n2 (- n 2)‍)
                (+ (fib n1)
                   (fib n2))‍)))

まあまあですね。

オリジナルのポーランド記法にこだわる

Lispの表記法は、括弧を明示するので、Cambridge Polish Notationなどとも呼ばれます。
しかし、オリジナルのポーランド記法は、アリティが決まっているなら括弧を不要にできることこそがその特長だったようです。
その意向を汲んでみました。

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

アリティを暗記していないといけないので、読み書きで脳に負担がかかりそうですね。

結論

括弧は脳に優しい。

■

HTML generated by 3bmd in LispWorks 7.1.0

Lisp Advent Calendar 2017 五日目です。

Common Lisp は移動体上でのタイムゾーンを意識して設計されている?

Common Lispのタイムゾーンについては移動体のことを考慮し、定数になっていないというような話が前々から気になっていたので、実際のところどうなのだろうと思って調べてみた。

CLtLでタイムゾーンを返すものが変数ではなく関数なのは、タイムゾーン間を移動する乗り物に使われた場合を想定しているという説明で配慮の細かさに感動したが、乗り物にCommon Lispが使われているという例を知らない。

— Miura Hideki (@miura1729) October 29, 2011

Common Lispでタイムゾーンを返す関数は、移動している車等での使用を考慮して、定数ではなく関数にしたという話を思い出した。　>RT

— Miura Hideki (@miura1729) August 18, 2013

その点、Common Lispは乗り物での運用を考えてタイムゾーンは定数ではなく関数

— Miura Hideki (@miura1729) November 30, 2017

元ネタ

多分、元ネタはCLtL2なんだろうと思うので検索してみると、CLtL2のget-decoded-timeとdecode-universal-timeの注釈にある、

Compatibility note: In Lisp Machine Lisp time-zone is not currently
returned. Consider, however, the use of Common Lisp in some mobile
vehicle. It is entirely plausible that the time zone might change from
time to time.

だと思われる。

• CLtL2:25.4.1. Time Functions

この注釈の解釈だけれど、Common Lispがタイムゾーンを意識してどうのこうのしたというよりは、互換性にかこつけて、Zetalispがタイムゾーンを返さないことについて細かいツッコミをいれているように思えるのだがどうだろうか。

CLtL1も確認してみたら、同様の記述だったので、1984年時点の認識らしい。

• CLtL1:Miscellaneous Features

移動体であればCommon Lisp処理系は結局ホストのOSかどこかからタイムゾーンの情報を貰ってくることになるが、基盤となるuniversal-timeは1900-01-01T00:00Zからの秒数なので基本的にこれが動くこともなく、どこのタイムゾーンとしてデコードするか、という話になる。
ちなみに、今どのタイムゾーンにいるかを処理系がホストと通信したりして把握する手順/機構のようなものはCommon Lispの規格上には定義されていない。

文句を付けられていたZetalisp(Lisp Machine Lisp)は実際どうだったのか

それで、実際Zetalisp(Lisp Machine Lisp)がどうだったのかをソースで確認してみたが、1982年頃のSystem 78.48では確かにタイムゾーンは返していなかった。
しかし、1984年のSystem 99のソースとその時期のマニュアルであるChinual 6ではタイムゾーンを返すようになっているので、CLtL1が出版された前後で既にCLtL1のZetalispとの互換性の注釈は、時代遅れなものになっていたらしい。

1984年は、MIT LispMもCommon Lisp化した時期なので、ZetalispがCommon Lispを取り込んでしまった、もしくは、ZetalispがCommon Lisp化した、とも考えられるので微妙ではあるが……。
1983年のChinual 5を眺めるとまだタイムゾーンは返していないようなのでCLtL1執筆時のツッコミがChinual 6に影響したのかもしれない。

しかし、1990年に出版されたCLtL2でも、この趣味的な記述がアップデートされることもなく、Zetalispはタイムゾーンを返さないといわれっぱなしで今に至ることになったらしい。

ちなみに、Zetalispでもuniversal-timeへのエンコードについては1980年より前からタイムゾーンは指定する仕様になっているので、デコードされたuniversal-timeから元のuniversal-timeが復元できない非対称性についてのツッコミであったかもしれない。

まとめ

Lisp関係の伝説においては、誰も気にしないので検証もされないような趣味的なものが延々と語り継がれることって多い気がする。
折角なのでスマホ上の処理系でGPSからデータを取得してuniversal-timeをデコードするようなものがあったら面白いかもしれない。

■

HTML generated by 3bmd in LispWorks 7.1.0

今年も始まりました、Lisp Advent Calendar 2017 第一日目です。
今回は、Hexstream CLOS MOP Specを紹介します。

Hexstream CLOS MOP Specというのは私が勝手に命名したものなので正式名称でもなんでもないのですが、 HexstreamことJean-Philippe Paradis氏がまとめたCLOS MOPのオンラインリファレンスです。

• Common Lisp Object System Metaobject Protocol

正式名称は、Common Lisp Object System Metaobject Protocol と素材そのままのようですね。

CLOS MOPとはなんぞや

そもそもCLOS MOPとは、ということになるのですが、Common Lispのオブジェクトシステムは、オブジェクト指向プログラミングによって、ユーザーがカスタマイズ可能です。
インスタンスの生成、スロット(メンバ変数)アクセス、継承の仕方等々が、プロトコルとしてまとめられているのですが、操作対象は通常のオブジェクトから一段階メタになってメタオブジェクトとなります。
通常のオブジェクトが車だとしたら、車を組み立てるロボット(仕組み)が更にまたオブジェクトになっていて色々いじれるという感じです。
車を組み立てるロボットをカスタマイズすることにより、車の作り方や、作られる車の構成をカスタマイズ可能、くらいの所でしょうか。

CLOS MOPでのメタオブジェトは総称関数、メソッド、スロット定義、メソッドコンビネーション、スペシャライザ等がありますが、Hexstream CLOS MOP Spec ではすっきり図になっているので、どんな感じの構成になっているかわかりやすいと思います。

• MOP » Classes » Class graph

CLOS MOPの仕様について

残念ながらこのCLOS MOPですが、ANSI Common Lispの規格には組込まれることはありませんでした。
割と早い段階からCLOS三部構成のうち、三番目に位置するものとされ、仕様も詰められていましたが、1990年代初頭当時としては野心的過ぎたのか、うちの処理系ではMOPはサポートしないと明言するような主力ベンダーも現われたり、紆余曲折あって、最初の二部までがANSI Common Lispとして規格化される、という流れになりました。

規格としてはまとまらなかったものの、その前の段階の準備や成果が、The Art of the Metaobject Protocolという書籍としてまとめられます。
(正確には同時進行ですが)
通称AMOPとして有名な本ですが、この本の5章と6章はCLOS MOPの仕様がまとめられた章で、この仕様の部分はオンラインでも公開され、CLOS MOPの仕様といえば、この公開されたAMOPの仕様部分ということになっています。

このAMOPのCLOS MOP仕様部分は、TeX等の形式で配布されていましたが、1997年に当時Eclipse Common Lispを作っていた Elwood Corporation の Howard R. Stearns氏がHyperSpecに似た感じのhtml形式にして公開しました。

これが広く長らく使われていて、Franzなどもマニュアルの一部として配布しています。

• The Common Lisp Object System MetaObject Protocol

しかし、Elwood版は、それほど使い勝手が良いとはいえず、改良するにもライセンスとして改変不可だったりするので、元のTeXからhtmlを仕立てる人が出てきたという所で、Robert Strandh氏や、今回紹介するHexstream氏のバージョンがそれにあたります。

• The Metaobject Protocol of the Common Lisp Object System

Strandh氏のものはシンプルにまとめてあり、さらに注釈も添えられ、HyperSpecへのリンクもあるので、読み進めるのに便利です。
このStrandh氏のまとめたものを更に体裁よくまとめたものが、Hexstream氏のバージョン、というところです。

たとえば、Hexstream氏のものはプロトコルごとに眺められたりして、なかなか良いです。

• Navigation » Protocols

また、関数名がidになっているので、Emacs等からドキュメントを検索するのも楽です。
簡単な関数を書けば、ブラウザで開くことも可能でしょう。

(defun amop-lookup (&optional symbol-name)
  (interactive)
  (let ((name (or symbol-name
                  (thing-at-point 'symbol))))
    (setq name (subseq name (1+ (or (string-match ":" name) -1))))
    (browse-url
     (format "https://clos-mop.hexstreamsoft.com/generic-functions-and-methods/#%s"
             name ))))

(c2mop:effective-slot-definition-class ...)

のようなシンボルの上で、M-x amop-lookupすれば、該当のページが開きます。

まとめ

今回は、Hexstream CLOS MOP Specを紹介しました。

とっつきにくいAMOPのリファレンスですが、綺麗にまとまっていると読み進めるのが楽で良いですね。

■

HTML generated by 3bmd in LispWorks 7.1.0

大分古くからあるものだけれど、Olin Shivers氏が式のボディ部が無限リストになっているという面白いアイデアを書いていて、以前ちょっと考えてみたりした。

• ボディが無限リスト

無限リストに関数を詰めて呼んでみたり、という感じだったけれども、より直接的には、evalが使えるなと考えた。

なお、評価はちょっと間違うと無限ループになるので注意。

(progv '(i) '(0)
  (catch :exit
    (eval
     '(progn . #0=((when (= 1000 i) (throw :exit :done))
                   (print i)
                   (incf i)
                   . #0#)))))

以上、暇だったので。

■

HTML generated by 3bmd in LispWorks 7.0.0

昨日のエントリーで「なぜかbench-stringというベンチでClaspがズバ抜けて速い」と書いたが、Twitterでこの件について反応があった。

BENCH-STRING が速いの、最適化でその部分のコードがごそっと削除されてるからとかいうオチがありそうな。
— Kei @tk_riple

なるほど、最適化によるコード削除疑惑。
Common Lispの場合、最適化した際にdotimes等で返り値を使わない場合によく消えたりはするかもしれない。
しかし、消えてる感じにしては遅いので、まあまあそんなものかなと思っていた。
また、現状のClaspはまだ最適化がどうの、というより、まずは正しく動かすフェイズな気がするので、そんなに最適化もがんばってはいないという印象を持っていた。
実際、最適化の指定をしても型のヒントを与えても全然効いてないように思う。

結論: Claspのバグが原因で実行されないコードがあったため速かった

結論から書いてしまうと、Claspのfillのバグが原因でfill以降が実行されない為に速かった。
なので、最適化ではないけれど、searchの部分のコードが削除されていた状態になっていた。
一応順を追って説明してみる。

まず、元のコードについて。

(defun bench-strings (&optional (size 1000000) (runs 50))
  (declare (fixnum size))
  (let ((zzz (make-string size :initial-element #\z))
        (xxx (make-string size)))
    (dotimes (runs runs)
      (and (fill xxx #\x)
           (replace xxx zzz)
           (search "xxxd" xxx)
           (nstring-upcase xxx))))
  (values))

同じ長さの大きい文字列を2つ作ってfillで‘x’で埋め、もう片方でreplaceし、“zzzz…”という文字列にしてしまう。
それをsearchで“xxxd”について検索するが見付からないので、nstring-upcaseは実行されない、という流れ。

andで繋いでいるのは、指摘があったような最適化でコードが消えるのを防いでいるのかもしれない。

とりあえず、dotimesの中身を全部消したものと比較すると、全部消したものがずっと速いので、中身を全部消しているということはなさそう。

そこで一つずつ足していってみたが、そこでClaspのvectorに対してのfillの返り値がnilであることに気が付いた。
仕様では、fillはsequenceを返すことになっているが、nilが返ってしまうとandで繋いでいるだけに以降が実行されないことになってしまう。

Claspのソースを確認してみると、

(defun fill (sequence item &key (start 0) end)
  ;; INV: WITH-START-END checks the sequence type and size.
  (reckless
   (with-start-end (start end sequence)
     (if (listp sequence)
         (do* ((x (nthcdr start sequence) (cdr x))
               (i (- end start) (1- i)))
              ((zerop i))
           (declare (fixnum i) (cons x))
           (setf (first x) item))
         (si::fill-array-with-elt sequence item start end)))))

となっていて、vectorの場合は、si::fill-array-with-eltの返り値となるが、そのsi::fill-array-with-eltはClaspらしくC++で書かれていた。

/*! Fill the range of elements of the array,
   if end is nil then fill to the end of the array*/
CL_LISPIFY_NAME("core:fill-array-with-elt");
CL_DEFUN void core__fillArrayWithElt(Array_sp array, T_sp element, cl_index start, T_sp end) {
    size_t_pair p = sequenceStartEnd(core::_sym_fillArrayWithElt,
                                     array->arrayTotalSize(),start,end);
    array->unsafe_fillArrayWithElt(element,p.start,p.end);
  }

core__fillArrayWithEltはvoidなので、多分CLの世界ではnilを返すことになるのだろう。

ということで、

(defun fill (sequence item &key (start 0) end)
  ;; INV: WITH-START-END checks the sequence type and size.
  (reckless
   (with-start-end (start end sequence)
     (if (listp sequence)
         (do* ((x (nthcdr start sequence) (cdr x))
               (i (- end start) (1- i)))
              ((zerop i))
           (declare (fixnum i) (cons x))
           (setf (first x) item))
         (si::fill-array-with-elt sequence item start end))
     sequence)))
(fill (make-string 42) #\*)
→ "******************************************" 

のように修正し、再度SBCLと比べてみた

バグを修正して再計測: 最適化指示ありなしで比べてみる

最適化指示なしだと依然としてClaspの方が3倍位速いらしい。
しかし、指示ありだと、SBCLがClaspの2倍位速くなった。
一応SBCLの方のdisassemble結果を確認したが、中身がごっそり消されているということはなかった。

Claspの方は、最適化指示ありでもなしでもあまり変わらず。
従来のCL処理系は、普段は遅めだけど、追い込むと速い、という傾向があるが、Claspは、普段から速めで、追い込んでもそんなに速くならない系になっていくのかもしれない。

なお、一応Claspにバグ報告は出してみた。

SBCL

(bench-strings)
;=> nil
#|------------------------------------------------------------|
Evaluation took:
  0.595 seconds of real time
  0.594982 seconds of total run time (0.594982 user, 0.000000 system)
  100.00% CPU
  1,958,880,795 processor cycles
  8,000,064 bytes consed
Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz
 |------------------------------------------------------------|#

Clasp

(bench-strings)
;=> nil
#|------------------------------------------------------------|
Real time           : 0.208 secs
Run time            : 0.208 secs
Bytes consed        : 8026792 bytes
LLVM time           : 0.000 secs
LLVM compiles       : 0
clang link time     : 0.000 secs
clang links         : 0
Interpreted closures: 0
nil
 |------------------------------------------------------------|#

SBCL 最適化指示あり

(defun bench-strings+ (&optional (size 1000000) (runs 50))
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (declare (fixnum size runs))
  (let ((zzz (make-string size :initial-element #\z))
        (xxx (make-string size)))
    (declare (simple-string xxx zzz))
    (dotimes (runs runs)
      (and (fill xxx #\x)
           (replace xxx zzz)
           (search "xxxd" xxx)
           (nstring-upcase xxx))))
  (values))
(bench-strings+)
;=> nil
#|------------------------------------------------------------|
Evaluation took:
  0.104 seconds of real time
  0.103990 seconds of total run time (0.103990 user, 0.000000 system)
  100.00% CPU
  342,637,002 processor cycles
  8,000,064 bytes consed
Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz
 |------------------------------------------------------------|#

Clasp 最適化指示あり

(proclaim '(optimize (speed 3) (safety 0) (debug 0)))
(defun bench-strings+ (&optional (size 1000000) (runs 50))
  (declare (fixnum size runs))
  (let ((zzz (make-string size :initial-element #\z))
        (xxx (make-string size)))
    (declare (simple-string xxx zzz))
    (dotimes (runs runs)
      (and (fill xxx #\x)
           (replace xxx zzz)
           (search "xxxd" xxx)
           (nstring-upcase xxx))))
  (values))
(bench-strings+)
;=> nil
#|------------------------------------------------------------|
Real time           : 0.222 secs
Run time            : 0.222 secs
Bytes consed        : 8026792 bytes
LLVM time           : 0.000 secs
LLVM compiles       : 0
clang link time     : 0.000 secs
clang links         : 0
Interpreted closures: 0
nil
 |------------------------------------------------------------|#

■

HTML generated by 3bmd in LispWorks 7.0.0

Shibuya.lisp Lispmeetup #57 の発表でClaspがSBCLより速かったりするらしいというのを耳にして、いつの間にかそこまで進歩してたのかと思ったので早速自分も試してみることにした。

ビルドは、本家のWikiの通りに実行し特に問題もなくビルドはできた。ただ時間は、3時間程度掛った。
Clasp 0.5 Build Instructions

cl-benchで計測してみる

• cl-bench

3年位前にclaspが登場した頃に、一度clasp 0.2でcl-benchを実行してみたが、完走できない項目ばかりだった。
今回のclasp 0.5で試してみたところ大体の項目が完走できた。しかし物によってはSegmentation faultで処理系ごと落ちたりもする。
cl-bench は、Symbolics CLや、Lucid CLでも走る位なので可搬性は高い、というか規格内の機能だけで書いてある(多分)。

cl-benchや手元で確認してみる感じでは、SBCLより速かったりすることは無さそうに思えた。
さらに安定性については、まだ比較対象にならないという感じ。

目につくところでは、なぜかbench-stringというベンチでClaspがズバ抜けて速い。
bench-stringの定義はこんな感じ

(defun bench-strings (&optional (size 1000000) (runs 50))
  (declare (fixnum size))
  (let ((zzz (make-string size :initial-element #\z))
        (xxx (make-string size)))
    (dotimes (runs runs)
      (and (fill xxx #\x)
           (replace xxx zzz)
           (search "xxxd" xxx)
           (nstring-upcase xxx))))
  (values))

全体的な印象としては、依然としてClaspはまだまだ開発中という感じがした。
ClaspはC++との連携が最大の強みだと思うが、自分はC++の資産を使うこともないので、UTF-8をサポートするまで様子見でも良いかなというところ。
ちなみに、個人的には、SICLのコードが全面的に使われるらしいというところに興味がある。現状は、まだまだECLのコードが多い様子。

下記にベンチ結果を載せてみる。
なお、ECLやClaspと同じくSBCLはGMPを有効にしてある。 使用したマシンは、CPUが、Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz でメモリは32GiB

ベンチ

■

HTML generated by 3bmd in LispWorks 7.0.0

日立が開発していたメインフレーム用Common LispであるHiLISP(VOS3 LISP)についての記事・知識処理用言語HiLISPの高速化方式 — 日立評論 1987年3月号を読んでいて、再帰呼び出しを一回だけインライン展開するという方法が紹介されているのを目にした(記事では、自己再帰展開と呼んでいる)。

面白そうなのでこの自己再帰展開™というものを再現してみることにした。

最近のCommon Lispの処理系ではインライン指定すれば再帰的に展開してくれるものもあれば、そうでないものもあり、展開の仕方もまちまちだけれどもfletで関数内関数を定義し、それにインライン指定すれば簡単に実現できると思われる。

(defmacro defsubstself (name (&rest args) &body body)
  `(defun ,name (,@args)
     (flet ((,name (,@args)
              ,@body))
       (declare (inline ,name))
       ,@body)))

(defsubstself fib/ (n)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (declare (fixnum n))
  (the fixnum
       (if (< n 2)
           n
           (+ (fib/ (1- n))
              (fib/ (- n 2))))))
===>
(defun fib/ (n)
  (flet ((fib/ (n)
           (declare (optimize (speed 3) (safety 0) (debug 0)))
           (declare (fixnum n))
           (the fixnum (if (< n 2) n (+ (fib/ (1- n)) (fib/ (- n 2)))))))
    (declare (inline fib/))
    (declare (optimize (speed 3) (safety 0) (debug 0)))
    (declare (fixnum n))
    (the fixnum (if (< n 2) n (+ (fib/ (1- n)) (fib/ (- n 2)))))))

fletの関数定義部のボディの中で自己を参照することはないので、一回だけ展開させるには都合が良い。

自己再帰展開™fibと通常のfibを比べるとLispWorksでは25%程高速化した。
めでたしめでたし。

解決かと思ったが……

fletを使えばできると思ったが、しかし、大域関数をfuncallした場合は、どうなるだろう。
もちろんfletで作った関数は大域関数ではないので呼ぶことはできない。
具体的には下記のような場合。

(defun fib (n)
  (declare (optimize (speed 3) (debug 3) (safety 0)))
  (declare (fixnum n))
  (the fixnum
       (if (< n 2)
           n
           (+ (funcall 'fib (1- n))
              (funcall 'fib (- n 2))))))

そもそも、こういう場合は、インライン展開はどうなるのだろうか。
インライン展開してくれそうな処理系で調べてみると、fibにinline宣言がされた場合の挙動は、

という風に、展開したりしなかったりの様子。
funcall 'fnでもコンパイル時にはインライン指定のスコープはfuncall #'fnと同様に確定できると思われるので、SBCLが展開しないのはちょっと不思議。

3.2.2.3 Semantic Constraints にも

Within a function named F, the compiler may (but is not required to)
assume that an apparent recursive call to a function named F refers to
the same definition of F, unless that function has been declared
notinline. The consequences of redefining such a recursively defined
function F while it is executing are undefined.

とあるので、コンパイル時に確定はできそうだけれど、an apparent recursive call to a function named Fにfuncall 'fn形式が含まれるのかは良く分からない。
(functionの定義からして、funcall #'functionは含まれるだろう)
もしかすると、LispWorksがやりすぎなのかもしれない。

ちなみに、Allegro CLはインラインについて一家言あるようなので展開しないらしい。

• Inline declarations ignored

LispWorksでは、funcall 'fnでもインライン展開するので、大域の補助関数を作成して、それを呼び出せば良さそうだけれど、SBCLではそれでは駄目なので、結局はコードウォーキングしないといけないらしい。

ということで処理系に備わっているwalk-formを使って下記のようなものを書いてみた。

(import (find-symbol (string '#:walk-form)
                     #+allegro :excl
                     #+sbcl :sb-walker
                     #+lispworks :walker))

(defun replace-fn (fsym replace form env) 
  (let ((mark (gensym "mark")))
    (subst replace mark
           (walk-form 
            form
            env 
            (lambda (sub cxt env)
              (declare (ignore cxt env))
              (when (and (consp sub))
                (when (eq fsym (car sub))
                  (setf (car sub) mark))
                (when (and (eq 'function (car sub))
                           (eq fsym (cadr sub)))
                  (setf (cadr sub) mark))
                (when (or (eq 'funcall (car sub))
                          (eq 'apply (car sub)))
                  (when (and (eq 'quote (caadr sub))
                             (eq fsym (cadadr sub)))
                    (setf (caadr sub) 'function)
                    (setf (cadadr sub) mark))))
              sub)))))
(defmacro defsubstself (name (&rest args) &body body &environment env)
  (replace-fn name
              `(lambda (,@args)
                 ,@(copy-tree body))
              `(defun ,name (,@args) ,@body)
              env))

これは、自分の関数名の所をlambdaで置き換えてしまうので下記のような展開になる。
(なお、一度シンボルで置き換えてからlambdaフォームに直しているのは、walk-formが置き換えたフォームを更に展開し展開が止まらなくなるため。)

追記(2018-02-20)

walk-formがとる関数引数は多値を返すことになっていて、Tが返れば、それ以上展開しない、という指定が可能だった。
展開の指定をすれば、後でマーカーを置換するようなことはしなくても良い。
なお、大抵の処理系に付属のwalk-formはPortable CommonLoops(PCL)由来のものだが、この仕様は共通している。

(defun replace-fn (fsym replace form env) 
  (walk-form form
             env 
             (lambda (sub cxt env &aux stopp)
               (declare (ignore cxt env))
               (when (and (consp sub))
                 (when (eq fsym (car sub))
                   (setf (car sub) replace)
                   (setq stopp T))
                 (when (and (eq 'function (car sub))
                            (eq fsym (cadr sub)))
                   (setf (cadr sub) replace)
                   (setq stopp T))
                 (when (or (eq 'funcall (car sub))
                           (eq 'apply (car sub)))
                   (when (and (eq 'quote (caadr sub))
                              (eq fsym (cadadr sub)))
                     (setf (caadr sub) 'function)
                     (setf (cadadr sub) replace)
                     (setq stopp T))))
               (values sub stopp))))

上記では、lambdaで展開してしまったが、fletでfibを定義し、funcall 'fibをfuncall #'fibに書き換えても良いと思う。

(defsubstself fib (n)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (declare (fixnum n))
  (the fixnum
       (if (< n 2)
           n
           (+ (funcall 'fib (1- n))
              (funcall 'fib (- n 2))))))
===>
(defun fib (n)
  ...
 (the fixnum
      (if (< n 2)
          n
          (+ (funcall #'(lambda (n)
                          (declare (optimize
                                    (speed 3)
                                    (safety 0)
                                    (debug 0)))
                          (declare (fixnum n))
                          (the fixnum
                               (if (< n 2)
                                   n
                                   (+ (funcall 'fib
                                               (1- n))
                                      (funcall 'fib
                                               (- n
                                                  2))))))
                      (1- n))
             (funcall #'(lambda (n)
                          (declare (optimize
                                    (speed 3)
                                    (safety 0)
                                    (debug 0)))
                          (declare (fixnum n))
                          (the fixnum
                               (if (< n 2)
                                   n
                                   (+ (funcall 'fib
                                               (1- n))
                                      (funcall 'fib
                                               (- n
                                                  2))))))
                      (- n 2)))))))

こうするとSBCLでも30%程の高速化となった。
ちなみに、Allegro CLだと普通に書いたものより遅くなるため、余計なことはしない方が良いらしい。

結び

HiLISPがfuncall 'fnをどう解釈するのかは分からないので、展開する場合としない場合を考えてみた。

Common Lispではインライン指定は処理系によって任意に解釈できることは知っていたが、調べてみると結構ばらばらなんだなと思った次第。
ちなみにSBCLでは、再帰的な局所関数ではlabels+inline指定をすると展開がかなり効く模様。
なお、大抵の処理系では、今回のような手作りの展開で速くなるが、Allegro CLの場合は、別の作法があるらしく、寧ろずっと遅くなるので注意。

■

HTML generated by 3bmd in LispWorks 7.0.0

Common Lispでは carからcddddrまで30のcarとcdrの組み合わせが備え付けで定義されているが、Common Lispプログラマは、caadarのようなものを一体どのように発音しているのだろうか。

このブログのドメイン名は、cddddr.orgだが、くだだだ・だーと日本語の語感として口にしやすいので選んだりしたのだが、dの連続は良いとしても、aの連続や、cdrとcdarの違い等はどう表現したら良いのか良くく分からない。

RMSが講演でcaarを「か・あー」と発音していたのを観て、なるほど区切ってみたら案外区別が付くかもなと思い、Common Lispの備え付けに日本語的な発音を付けてみた。

区切りは、a→aとd→aに遷移する時に付けると区別がつきやすいように思う。
また、aが連続する場合は、一番目と二番目の間だけ区切りをはっきりさせると発音しやすい。

下記では区切りを促音にしているが、長音にしても良いだろう。

なお、カダーはキャダーという人もいるようだ(RMSもキャダーと発音していた)。
また、RG(グリーンブラット)は、CADRマシンをカダーと発音していた。同じMITでもまちまちらしい。

• car: かー
• cdr: くだー
• caar: かっあー
• cadr: かだー
• cdar: かっだー
• cddr: くだだー
• caaar: かっああー
• caadr: かっあだー
• cadar: かだっあー
• caddr: かだだー
• cdaar: くだっああー
• cdadr: くだっあだー
• cddar: くだだっあー
• cdddr: くだだだー
• caaaar: かっあああー
• caaadr: かっああだー
• caadar: かっあだっあー
• caaddr: かっあだだー
• cadaar: かだっああー
• cadadr: かだっあだー
• caddar: かだだっあー
• cadddr: かだだだー
• cdaaar: くだっあああー
• cdaadr: くだっああだー
• cdadar: くだっあだっあー
• cdaddr: くだっあだだー
• cddaar: くだだっああー
• cddadr: くだだっあだー
• cdddar: くだだだっあー
• cddddr: くだだだだー

この法則でいくと、本題名のcadadadadddrは、かだっあだっあだっあだだだーと読めることになる。 以上、おそまつ。

■

HTML generated by 3bmd in LispWorks 7.0.0

Common Lisp製のEmacs系エディタのlemがOpen Collectiveに参加したとのことで、自分も支援してみた。
自分はLispWorksを利用していて、折角LispWorksを購入したからには元を取ろうという貧乏くさい考えで、この二年位は殆どCommon Lispのコードは元より普段の職場での仕事でもLispWorksのエディタでテキストを編集している。

ということで、lemは使ったことがなかったのだが、折角なので使ってみた。

導入

とりあえず、GitHub: cxxxr: lemからソースを持ってきて、Quicklispがロードできる場所に配置。
自分は、Common Lisp処理系内部から使う派なので、あとは、(ql:quickload :lem)して、Common Lisp処理系をダンプするかすることにした。
ちなみに残念ながら現状LispWorks 7.0では上手く動かないらしい。後でちょっとみてみようかなと思う。

使ってみる

起動は、(lem:lem)。伝統のed関数から呼び出すようにしても良さそう。

自分的に必須コマンドである()を対で入力してくれるコマンド(make-())と、コッカからの移動コマンド(move-over-))がなかったので追加してみた。
lemの所作が良く分からないが、とりあえず動けば良いかなという感じ。
ちなみにこれらコマンドは1970年代のEmacsから存在している。

;; -*- lisp -*-
(ql:quickload :g000001.tools.tpd-blog)
(in-package :lem)
(define-key *global-keymap* "C-_" 'undo)
(deftype whitechar ()
  '(member #\Space #\Tab #\Return #\Newline))
(define-command make-\(\) (n) ("p")
  (let ((cp (current-point)))
    (insert-character cp #\( n)
    (insert-character cp #\) n)
    (prev-char n)))
(define-key *global-keymap* "M-(" 'make-\(\))
(define-key *global-keymap* "M-L" 'make-\(\))
(defun backward-search-rper ()
  (save-excursion
    (do* ((p (character-offset (current-point) -1))
          (c (character-at p)
             (character-at p)))
        ((char= #\) c) p)
      (unless (typep c 'whitechar)
        (return nil))
      (character-offset p -1))))

(defun backward-delete-to-rper ()
  (save-excursion
    (do* ((p (character-offset (current-point) -1))
          (c (character-at p)
             (character-at p)))
        ((char= #\) c) p)
      (unless (typep c 'whitechar)
        (return nil))
      (delete-character p)
      (character-offset p -1))))
(define-command move-over-\) () ()
  (let ((rper (backward-search-rper)))
    (if rper
        (progn
          (backward-delete-to-rper)
          (scan-lists (current-point) 1 1 T)
          (lem.language-mode:newline-and-indent 1))
        (progn
          (scan-lists (current-point) 1 1 T)
          (lem.language-mode:newline-and-indent 1)))))
(define-key *global-keymap* "M-)" 'move-over-\))
(define-key *global-keymap* "M-:" 'move-over-\))
(define-command Process-Entries-And-Preview (p) ("p")
  (declare (ignore p))
  (g000001.tools.tpd-blog:process-entries-and-preview
   (buffer-filename (current-buffer))
   #P"/mc/"))
(define-command Publog (p) ("p")
  (declare (ignore p))
  (g000001.tools.tpd-blog:publish-entries-and-preview 
   (buffer-filename (current-buffer))))
(define-command Insert-UNIVERSAL-TIME (p) ("p")
  (declare (ignore p))
  (let ((ut (get-universal-time)))
    (multiple-value-bind (s m h d mo y)
                         (decode-universal-time ut)
      (declare (ignore s))
      (insert-string (current-point)
                     (format nil
                             "~D ;~D-~2,'0D-~2,'0DT~2,'0D~2,'0D"
                             ut y mo d h m)))))
;;; *EOF*

むすび

このブログはLispWorksのエディタから更新できるようにしていたが、何故か無駄に更新コマンドに可搬性を持たせて作成していたので、LispWorksのコマンドをちょっと変更するだけでlemからもこのブログを更新できるようになった。
ということで、この記事も記念にlemで書いてlem上から更新を実行してみた。

また、TwitterもLispWorksからしているが、これもちょっとしたコマンドの書き直しでlem上から簡単につぶやけるようになった。
基本的にエディタ側で作り込むのではなくCommon Lisp側で完結するツールを作成し、フロントエンドはほぼ呼び出すだけの構成にしておくとSLIME・lem・LispWorks等エディタで共通で使いまわせるので良いかもしれない。

lemは現在ターミナルで動くが、今後ブラウザ上や、Electron化も検討されているらしいので色々期待している。

■

HTML generated by 3bmd in SBCL 1.4.0

前回は、

• [TCH,LSP]
• [DWP,LSP]
• [LAP,LSP]
• [WD,LSP]

を眺めた。
今回も引き続き下から順番に確認していくことにしよう。

[STR,LSP]

• https://www.saildart.org/[STR,LSP]/

Common Lispの国際標準化についての議論が行なわれていたメーリングリスト。
日本やヨーロッパ勢も参加し、ANSIからISOの流れに繋がっていく。

またこれもmhonarcでhtml化してみた。

• cl-steering

[PLC,LSP]

• https://www.saildart.org/[PLC,LSP]/

日本の奥乃博先生が中心となって開催された、第三回LISPコンテストおよび第一回PROLOGコンテストのファイル
コンテストは各種ベンチマークの性能を比べる。
何故ここにあるのか謎だが、奥乃先生がSAILにいらしたのと関係があるのかもしれない。
ProLog Contestの略かと思われる。

参考

• 第三回LISPコンテストおよび第一回PROLOGコンテストの課題案

[LSC,LSP]

• https://www.saildart.org/[LSC,LSP]/

同上でこちらは、LiSp Contestのファイル

[MLI,LSP]

• https://www.saildart.org/[MLI,LSP]/

SAILで開発され使われていたALGOL記法のLISPであるMLISPのファイル。
処理系のファイルや、メールサーバーのソースコードっぽいものが点在。

参考

• レトロLisp探検: MLISP — #:g1

[WHT,LSP]

• https://www.saildart.org/[WHT,LSP]/

CLtL1のTeX原稿。TeXのマクロでBOLIO風の記述ができるようにしているらしい。
(BOLIOとはMIT Lispコミュニティで利用されていたマークアップ言語)

ファイルを眺めると、CLtL1はSpice Lispのマニュアルの原稿を上書きして作っていたことが分かる。

CLtL2はHTML化され今でも閲覧できるサイトもあり入手も可能だが、CLtL1はHTML化はされていないので案外貴重。
そのうちHTML化してみたい。

今回はここまで。

■

HTML generated by 3bmd in LispWorks 7.0.0

SAILとは、Stanford Artificial Intelligence Laboratoryの略でスタンフォードAIラボのこと。
DARTとはDump And Restore Techniqueの略だそうで、1972から1990位まで稼動していたバックアップシステムだそう。
そのアーカイブが10年位前から公開されているのが、SAILDART.ORG。
アーカイブの中には、マッカーシー先生や、クヌース先生のホームディレクトリがあったりもするし(非公開)、TeXが生れたシステムでもあるので、TeX関係のファイルも多数ある。
Lisp関係では、Common Lispの仕様策定のメールでの議論は、ここSAILのシステムを中心としていたようで多数のお宝が眠っている(と私のようなマニアは考えている)

以前から発掘に勤しんでいるのだが、一度端から端まで確認してみようかなと思い、ブログに記録を残しことにしてみた次第。

まず、システムのLSPディレクトリがあり、このディレクトリは ざっとこんな感じ

• [MAC,LSP]
• [TIM,LSP]
• [COM,LSP]
• [CLS,LSP]
• [206,LSP]
• [NEW,LSP]
• [FTL,LSP]
• [MRS,LSP]
• [AID,LSP]
• [VLI,LSP]
• [T,LSP]
• [VIO,LSP]
• [RUT,LSP]
• [OLD,LSP]
• [IL,LSP]
• [LSP,LSP]
• [SCH,LSP]
• [CMP,LSP]
• [BUG,LSP]
• [LIB,LSP]
• [QLA,LSP]
• [X3,LSP]
• [WHT,LSP]
• [MLI,LSP]
• [LSC,LSP]
• [PLC,LSP]
• [STR,LSP]
• [TCH,LSP]
• [DWP,LSP]
• [LAP,LSP]
• [WD,LSP]

ディレクトリの名前からだと、中身がなんだかさっぱり見当がつかないが、とりあえず下から全部確認していくことにしよう。

[WD,LSP]

• https://www.saildart.org/[WD,LSP]/

READ.MEに

THIS DIRECTORY CONTAINS EXPERIMENTAL LISP SYSTEM PROGRAMS WHICH SHOULD
NOT BE DEPENDEN UPON

等々とあるので、WDとは、Working Directoryの略かなんかだろうか。

特に見るべきものもないが、pretty.rutのファイルは、UCI LISPのプリティプリンタの定義かなんかだろうか。

[LAP,LSP]

• https://www.saildart.org/[LAP,LSP]/

ここも良く分からないが、UCI LISPっぽい。dfuncというのは、UCI LISPのdefunみたいなもだったと思う。
Scheme等と同じく(dfunc (foo arg)...)という形式なのが面白い。
1973年のファイルなので、この定義形式はSchemeに先行するだろう。

[DWP,LSP]

• https://www.saildart.org/[DWP,LSP]/

READ.MEに

All files here are on the LISP UDP as of 5/7/80.
        -rpg-

とあるがまったく意味が不明

MLISPの処理系のソースっぽいものがMIDASで書かれている断片がある。

[TCH,LSP]

• https://www.saildart.org/[TCH,LSP]/

Common Lispの仕様策定のグループで標準化について技術的な議論をするメーリングリストのアーカイブが置かれていた場所らしい。 メーリングリストの名前は、cl-technical TCHとはtechnicalということか。

とりあえずmhonarcでまとめてみた。

• CL-Technical

とりあえず、満足したので今日はここまで。

■

HTML generated by 3bmd in LispWorks 7.0.0

defclassで構造体を定義するのってできなかったっけかなあと思い、ちょっと調べてみたが、どうもstructure-classとの統合は未完に終わっているようで、MOPでも構造体の生成についての記述はない様子。

(make-instance (make-instance 'structure-class))

に類することができれば、どうにかなりそうだが、思えば構造体にそのような道具はなく、実行時に定義するならコードを生成してからevalみたいなことになりそうだ。
ちなみに、evalが絡むと大抵

(let ((x 42))
  (defstruct foo
    (x x)
    y
    z))
(make-foo)
→ #S(foo :x 42 :y nil :z nil) 

みたいなことができなくなるので避けたい所。
(但し構造体については上記ができても殆ど意味がない)

構造体の定義については、defstructを書くしかないという結論になったが、それでは、defclassをdefstructに展開する方向で考えてみようということで、これに使えそうな、expand-defclassを思い出したので使ってみることにした。

(defmethod clos::expand-defclass ((proto structure-class) 
                                  (metaclass (eql 'structure-class))
                                  name
                                  supers
                                  slots
                                  class-options)
  `(defstruct (,name (:include ,@supers))
     ,@(mapcar (lambda (s) 
                 (if (consp s)
                     `(,(car s) ,(getf (cdr s) :initform))
                     `(,s nil)))
               slots)))

これを使うと下記のように書ける

(defstruct foo 
  x
  y
  z)
(defclass bar (foo)
  ((a :initform 42)
   b
   c)
  (:metaclass structure-class))
(make-bar)
→ #S(bar :x nil :y nil :z nil :a 42 :b nil :c nil) 

(defclass bar (foo)
  ((a :initform 42)
   b
   c)
  (:metaclass structure-class))

をマクロ展開すると、

(defstruct (bar (:include foo)) (a 42) (b nil) (c nil))

となる。

expand-defclassについて

expand-defclassは、MOPの初期(1987年頃)には存在していたが、定義構文の展開方法については具体的に規定しないことになり、定義構文のマクロ展開メソッドは諸々1988年には消えてしまった。
そのためAMOPには載っていない。

• X3J13 88-003R(DRAFT:1987-12-13)

(expand-defclass prototype-instance name superclasses slots options environment)

という総称関数だが、展開がメソッドでカスタマイズできるというのが、なかなか良さそう。
なお、LispWorks版は、environment 引数は取らないが、環境は取り込んでいるので謎なことをしている様子。

なお、初期MOPの仕様にほぼ沿っているexpand-defclassは、調べた限りでは、どうもLispWorksにしか存在しないようだ。
(TI ExplorerのTICLOSにはFlavorsで定義されているexpand-defclassがあったのと、Portable CommonLoopsに仕様が違う同名の関数があった。)

まとめ

Common LispもDylan位に色々統合されてくれていたら良かったのになと思ったりする。
ちなみに、Dylanでは動的さが制御できるので性能を出したい場合は制限をかけるようになっている。

• Dylan中間マニュアル | 8. ダイナミズムの制御

また、Eclipse Common Lispは全面的にOOPで書かれているが、Dylanのようにsealed指定が可能なように拡張されていたようだ。

■

HTML generated by 3bmd in LispWorks 7.0.0

今日comp.lang.lispの過去ログを眺めていたら、SETFのFはFunctionのF説を説明している人をみつけた。

• Re: History of Comment Style & Names

The thread suggests both FORM and FIELD, but the original meaning was
FUNCTION :-) When the construct was first suggested it was called
SETFQ for "set with function quoted, everything else evaluated", and
only later abbreviated to SETF. (Source: the Gabriel/Steele "Evolution
of Lisp" paper in HOPL-II).

自分もMITのLispマシングループが元ネタとしたA LISP machine with very compact programsの論文には、FieldやFormという記載はなく、Fといえば、Function位だよなあと思っていたが、Evolution of Lispにも記載があるとのことなので確認してみたら、

Deutsch commented that the special form used here is called SETFQ because 
"it quotes the function and evaluates everything else." 
This name was abbreviated to SETF in Lisp-Machine Lisp. 
Deutsch attributed the idea of dual functions to Alan Kay

と書いてあった。
また、Deutsch氏の論文にも、

A more useful function is (SETFQ (fn arg1 ... argn) newvalue)
which quotes the function name and evaluates everything else. 
This allows RPLACA, for example, to be defined as (LAMBDA (X Y) (SETFQ (CAR X) Y) ).

とあり完全に見逃していたらしい。
この論文でいうFunctionは、CLでいうsetfのaccessorみたいな所。

ちなみに、他の説も挙げておこう。

FはForm説

これはsetfはシンボルだけではなくフォームを取るからなんだろうけど、特に誰かの裏付けはなく、なんとなくの皆の印象という感じだろうか。

FはField説

色々な所を眺めると、Kent Pitman氏が広めた感じだが、Pitman氏もDavid Moon氏から教えてもらったようなので大元はMoon氏らしい。
LISP 原書第3版(I) 13章 構造体 にも同様の説明がある。

ちなみに、Deutsch氏のsetfqの機構はAlan Kay氏のアイデアが源泉とあるが、Lisp界全体でこのアイデアが最初に登場したのは、更に10年程遡って1964年頃のLISP 2だったようだ。
なお、LISP 2はAlgolからヒントを得ている。
LISP 2のS式構文では、

(set (car x) 42)

のように書ける。

• LISP 2の先進性について — #:g1

まとめ

setfのFはFunctionのFだった。と書けば一行で終わる内容だが、色々書くとこんなに長くなる。

関連リンク

• Common-Lisp@SU-AI: SET vs. SETF
• Lisp本積読解消: LISP 原書第3版(I) | 13章 構造体 — #:g1
• Lispの変な関数名 — #:g1

■

HTML generated by 3bmd in LispWorks 7.0.0

ISLISPではCommon Lispのようなパッケージがなくても大丈夫、という話を耳にした。
プログラムの規模によっては大丈夫なのかもしれないが、ISLISPにもパッケージを導入した実装もあることだし、実際どうなのか調べてみた。

ちなみに、パッケージが付いたISLISPであるTISLのサイトは消滅しているので下記にarchive.orgのリンクを貼っておく

• ISO標準Lisp言語ISLISP処理系: TISL
• tisl_4_08_src.tar.gz

また、TISLのパッケージシステムについては下記の論文が一番詳しいようだ。

• ISLISP処理系TISLのためのパッケージシステム

ISLISPとモジュールシステム

とりあえず、調べて分かったことをまとめてしまうと

• ISLISPは産業利用が期待されており、モジュールシステムは必須と策定委員会も考えていた。
• 必須と考えてはいたものの、まとめ切れなかったので見送りとした。

ということらしい。

LISP言語国際標準化と日本の貢献 にはISLISPの成立までの流れが詳細に書いてあるが、Common Lispのパッケージシステムが採用されなかった理由としては、

• Common Lispのパッケージはデザインが古い
  • パッケージ間の名前の共有関係の静的チェックが困難
  • 名前の隠蔽をすることでの抽象化が上手く実現できない

あたりが述べられている。

Common Lispのパッケージシステムのデザインが良くないので、ISLISPに取り込まれず、ISLISPは将来の課題としたが、宙に浮いてしまった、というところだろうか。

ISLISPの話に、突然Common Lispが出てくるのに違和感があるかもしれないが、こちらもLISP言語国際標準化と日本の貢献を読めばISLISPがCommon Lispのサブセット的な面が強いことが分かると思う。
そもそもCommon Lispが成功したので、ANSIやISOで標準化しようという話になったが、ISO Common Lispが色々あって失敗し、ISLISPに至るという話でもある。

まとめ

ANSI Common Lispにしろ、ISLISPにしろ、時期尚早として見送ったものの、色々あってその時期は永遠にやってこなさそう、という話は多い気がする。

■

HTML generated by 3bmd in LispWorks 7.0.0

Perl6は以前から演算子などにUnicodeにASCII外の文字を積極的に使っているが、今回アトミックな操作の演算子として⚛がはいったらしい。

• Weekly changes in and around Perl 6: 2017.34 Going ⚛
• Perl 6 Documentation: class atomicint

こんな感じのコードらしいが、環境によっては絵文字になる様子。

my atomicint $i = 0;
start { $i ⚛= 1 }
while ⚛$i == 0 { }

ということで、マクロ文字でこういう拡張が簡単にできるCommon Lispでも早速真似してみたい。

(flet ((|read-🤙| (srm chr)
         (declare (ignore chr))
         (cl:quote cl:funcall))
       (|read-λ| (srm chr)
         (declare (ignore chr))
         (cl:quote cl:lambda)))
  (set-macro-character #\🤙 #'|read-🤙|)
  (set-macro-character #\λ #'|read-λ|))

(🤙(🤙(λ (f)
       ((λ (proc)
           (🤙f (λ (arg) (🤙(🤙proc proc) arg))))
        (λ (proc)
           (🤙f (λ (arg) (🤙(🤙proc proc) arg)))))) 
    (λ (f)
       (λ (n)
          (if (< n 2)
              n
              (+ (🤙f (1- n))
                 (🤙f (- n 2)))))))
  10)
→ 55 

Unicode 9.0 に Call Me Hand “🤙” (U+1F919) という丁度良いのがあったので使ってみた。

🤙 が開き括弧っぽいので、もう一捻りして、

(flet ((|read-🤙| (srm chr)
         (declare (ignore chr))
         (cons (quote funcall)
               (read-delimited-list #\) srm T)))
       (|read-λ| (srm chr)
         (declare (ignore chr))
         (cl:quote cl:lambda)))
  (set-macro-character #\🤙 #'|read-🤙|)
  (set-macro-character #\λ #'|read-λ|))

🤙🤙(λ (f)
       ((λ (proc)
           🤙f (λ (arg) 🤙🤙proc proc) arg))))
        (λ (proc)
           🤙f (λ (arg) 🤙🤙proc proc) arg)))))) 
    (λ (f)
       (λ (n)
          (if (< n 2)
              n
              (+ 🤙f (1- n))
                 🤙f (- n 2)))))))
  10)
→ 55

こんなのもどうだろうか。これならLisp-1と文字数は一緒になる。
とはいえ、ここまで来るとエディタにも追加設定して追従させないといけないが。 (Emacsなら括弧の文字設定が可能なので多分大丈夫だろう)

■

HTML generated by 3bmd in LispWorks 7.0.0

たった一人でCommon Lispの処理系を作るというのはあまり耳にしないけれど、そんな人も皆無ではない。
たとえば、XCLや、Eclips CL。
どちらももう開発は停止しているが、Eclips CLは、ANSI CL以降に実装されただけあって、処理自体がANSI CL以降のスタイルでOOP機能を使って書かれたりもしている。そしてMOP付き。

一人でMOP装備の処理系を開発しているというのは極端だけれど、チームで開発している人達も、大抵、既存のコンポーネントは再利用していることが殆ど。
Common Lispの処理系のコンポーネントの配布もまたかなり昔からある。

一番古い所では、Spice Projectが配布していたもので、1981・2年から存在する。
京大で独自に実装されたためKCLがこのキットを使っていなかったことに当時のCommon Lisp実装者達が驚いたのは有名(でもない)
ちなみに、Spice Projectのキットを使っていたものには、TOPS-20 Common Lispや商用のVAX LISPなども存在する。

また、オブジェクト指向システムでは、Portable CommonLoops(PCL)が参照実装として流通していて、なんだかんだで現在開発が活発なCommon Lisp処理系はどれもこれをベースにしている。

LOOPの実装は大抵の処理系は、MIT LOOPのバージョン829を元にしている。
MIT LOOPが大半なのでMIT LOOP依存なコードが発生してしまっているほど。

Common Lispからブートストラップする処理系としては、上述したHoward Stearns氏のEclisp CL、Robert Strandh氏のSICL、峯島氏のSacraがあり、Eclipse CLは商用処理系として販売もされていた。
SICLは規格に準拠したより綺麗な実装を目指していて、当該プロジェクト以外でもClaps等で、コンポーネントが利用されている。
Sacraは、XCLで部分的に利用されたりしている。

その他Thinlisp等トランスレータ系のソースもあり、さらにマニアックな所では、古いLispマシンのソースや、Lucid CLのソースも入手可能。
とはいえこの辺りはライセンスが微妙。(一応CADRは、MIT Licenseだが)

また、CLISPが結構独自実装なのでコードの再利用性は高いかもしれない。

以上、なんのまとまりもないがリンクを並べておく

• Spice Lisp キット
  • https://github.com/PDP-10/rutgers-common-lisp
• SICL
  • https://github.com/robert-strandh/SICL
• Thinlisp
  • https://github.com/vsedach/Thinlisp-1.1
• Sacla
  • http://minejima.jp/lisp/sacla/index-en.html
• Eclipse Common Lisp
  • https://github.com/blakemcbride/eclipse-lisp
• MIT LOOP
  • http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/code/iter/loop/mit/0.html
• Portable CommonLoops
  • https://github.com/binghe/PCL

■

HTML generated by 3bmd in LispWorks 7.0.0

Cray J90の公開エミュレータサイト現わる

先日、伝説のスパコンで有名なCray社のマシンであるCray J90のエミュレータを動かして公開している酔狂なサイトが登場した。

• Cray J90 emulation page

Cray J90は、Y-MPのエントリーレベルのマシンであるY-MP ELの後継機で1994年に登場したマシンらしい

• Cray J90

Cray J90 と Lisp

珍しいマシン環境を見付けたらまずLispが動くかどうかを調べたいところ。
ざっと検索してみたところ、Portable Standard Lisp(PSL)がCray上で稼動していたようだ。
PSLとは、数式処理システムのREDUCEを動かすことを念頭に置いて開発されたStandard Lispの後継で、より可搬性の高い処理系。

Portable Standard Lisp を Cray J90 でビルドする

PSLについても最近の環境でビルドできるようにして公開している方がいるので、こちらのソースを利用することにしてみる(とはいえターゲットは1994年の環境だが……)

• GitHub: blakemcbride/PSL

ちなみに、公開J90マシンへのファイルの転送はftpを利用するが、モードをpassiveにしないと上手く行かなかった(なんとなく懐かしい)

早速、ファイルを転送して展開する。
なお、当該機にgzipはないようなので注意。

makefileがgcc用なので、適当に修正する。

インタプリタのビルドは、make lispで、make lispcでコンパイラのビルドとなるが、インタプリタ環境ファイルとコンパイラ環境ファイルがごっちゃになるので、別々にした方が良いだろう。

とりあえず、make lispしてできたlispを環境が混ざらないように、別のディレクトリを作成し、そこに移動。そして実行してみる。

(de fib (n)
    (cond ((lessp n 2) n)
          (t (plus (fib (difference n 1))
                   (fib (difference n 2))))))

こんな感じのfibの定義を作成してloadさせてみる。

bash-2.03$ ./lisp
No initialization file: LISP-INI or LISP-INI
    S  T  D     L  I  S  P      [7.2] June 2015 
> (load "fib.lsp")
nil
> fib
> !$eof!$
> (fib 10)
55
> 

とりあえず動いた。

なお、コンパイラの方もlispcはできて実行できるのだが、どうも上手く動かせていない。

Common Lisp処理系は動くか

1994年の環境なので、KCL位なら動くかもしれない。
ちなみに、Franzの社史によると、Duane Rettig 氏が Allegro CLをX-MPに移植したとのこと。
Unicosは互換性が高いのでX-MP用のバイナリであれば動きそう。

• History of Franz Inc.

まとめ

やはりCrayのマシンはロマン。
興味のある方は是非UnicosでCommon Lisp処理系が動くようにして頂きたい。

■

HTML generated by 3bmd in LispWorks 7.0.0

Gambolとは、FROLICというCommon Lisp実装のS式Prologを拡張したものからProlog部分を抜き出したものらしい。

導入は、Quicklisp経由で、

(ql:quickload :gambol)

とすれば導入できる。

とりあえず、PrologのCommon Lisp実装を見付けたらZebraパズルでベンチをとってみることにしているので、早速いつもの組み合わせでベンチをとってみることにした。
(Allegro CL 8.2 64bit / Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz)

なお、gambolだと色々試しているうちに定義が混ざるので定義の度にリセットするようなマクロを書いた。
また、gambolでは、匿名変数は??の筈だが、??だとどうも上手く動かないので、#?というリーダーマクロで一意なシンボルを生成した。

(cl:in-package :cl-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :gambol))
(defpackage :gambol-zebra (:use :cl :gambol))
(in-package :gambol-zebra)
(eval-when (:execute :compile-toplevel :load-toplevel)
  (defvar *gambol-zebra-readtable*
    (copy-readtable nil))
  (set-dispatch-macro-character #\# #\?
                                (lambda (s c a)
                                  (declare (ignore s c a))
                                  (gensym "?"))
                                *gambol-zebra-readtable*)
  (setq *readtable* *gambol-zebra-readtable*))
(defmacro define-predicate (name &body clauses)
  `(progn
     (clear-rules '(,name))
     ,@(mapcar (lambda (c) `(*- ,@c)) clauses)))
(define-predicate member 
  ((member ?item (?item . #?)))
  ((member ?item (#? . ?rest))
   (member ?item ?rest)))
(define-predicate nextto
  ((nextto ?x ?y ?list) (iright ?x ?y ?list))
  ((nextto ?x ?y ?list) (iright ?y ?x ?list)))
(define-predicate iright
  ((iright ?left ?right (?left ?right . ?rest)))
  ((iright ?left ?right (?x . ?rest))
   (iright ?left ?right ?rest)))
(define-predicate zebra
  ((zebra ?h ?w ?z)
   ;; Each house is of the form:
   ;; (house nationality pet cigarette drink house-color)
   (= ?h ((house norwegian #? #? #? #?) ;1,10
          #?
          (house #? #? #? milk #?)
          #?
          #?))         ; 9
   (member (house englishman #? #? #? red) ?h)  ; 2
   (member (house spaniard dog #? #? #?) ?h)    ; 3
   (member (house #? #? #? coffee green) ?h)    ; 4
   (member (house ukrainian #? #? tea #?) ?h)   ; 5
   (iright (house #? #? #? #? ivory)             ; 6
           (house #? #? #? #? green) ?h)
   (member (house #? snails winston #? #?) ?h) ; 7
   (member (house #? #? kools #? yellow) ?h)   ; 8
   (nextto (house #? #? chesterfield #? #?)     ;11
           (house #? fox #? #? #?) ?h)
   (nextto (house #? #? kools #? #?) ;12
           (house #? horse #? #? #?) ?h)
   (member (house #? #? luckystrike oj #?) ?h)        ;13
   (member (house japanese #? parliaments #? #?) ?h)  ;14
   (nextto (house norwegian #? #? #? #?)               ;15
           (house #? #? #? #? blue) ?h)
   (member (house ?w #? #? water #?) ?h)  ;Q1
   (member (house ?z zebra #? #? #?) ?h)  ;Q2
   ))
(defun zebra-benchmark (&optional (n 1000))
  (declare (optimize (speed 3) (safety 0)))
  (let (rt0 rt1)
    (time (loop :initially (setf rt0 (get-internal-run-time))
                :repeat n 
                :do (pl-solve-one '((zebra ?h ?w ?z)))
                :finally (setf rt1 (get-internal-run-time))))
    (multiple-value-call #'values
      (/ (* n 12825) (/ (- rt1 rt0) 1000.0))
      (values-list (pl-solve-one '((zebra ?h ?w ?z)))))))