#:g1: frontpage

 

Lem使ってみた

Posted 2017-10-21 11:04:10 GMT

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

SAILDART Lispお宝発掘隊 (1)

Posted 2017-10-15 02:33:20 GMT

前回は、

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

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

[STR,LSP]

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

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

[PLC,LSP]

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

参考

[LSC,LSP]

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

[MLI,LSP]

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

参考

[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

SAILDART Lispお宝発掘隊 (0)

Posted 2017-10-02 17:06:24 GMT

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]

READ.MEに

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

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

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

[LAP,LSP]

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

[DWP,LSP]

READ.MEに

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

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

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

[TCH,LSP]

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

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

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


HTML generated by 3bmd in LispWorks 7.0.0

廃止になった expand-defclass について

Posted 2017-10-01 16:57:10 GMT

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を書くしかないという結論になったが、それでは、defclassdefstructに展開する方向で考えてみようということで、これに使えそうな、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には載っていない。

(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では動的さが制御できるので性能を出したい場合は制限をかけるようになっている。

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


HTML generated by 3bmd in LispWorks 7.0.0

SETFのFって結局なんなの

Posted 2017-10-01 14:34:54 GMT

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

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)

のように書ける。

まとめ

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

関連リンク


HTML generated by 3bmd in LispWorks 7.0.0

ISLISPにモジュールシステムがないのは何故か

Posted 2017-09-03 23:29:18 GMT

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

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

また、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

マクロ文字で絵文字を使おう

Posted 2017-08-22 16:34:42 GMT

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

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

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を実装するのに再利用できそうなコンポーネント群

Posted 2017-08-21 16:29:38 GMT

たった一人で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が結構独自実装なのでコードの再利用性は高いかもしれない。

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


HTML generated by 3bmd in LispWorks 7.0.0

CrayでLisp

Posted 2017-08-06 08:23:13 GMT

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

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

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

Cray J90 と Lisp

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

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

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

ちなみに、公開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用のバイナリであれば動きそう。

まとめ

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


HTML generated by 3bmd in LispWorks 7.0.0

GambolでZebraベンチ

Posted 2017-06-28 13:06:26 GMT

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)))))))

結果

結果は、82秒とPAIPrologの8倍遅い結果となった。
SBCLだと18秒、LispWorksだと30秒程度なので、Allegro CLと相性が良くないのかもしれない。
また、Allegro CLとLispWorksでは、スタックが溢れるので、

#+allegro (sys:set-stack-cushion nil)
#+lispworks (setq sys:*stack-overflow-behaviour* nil)

等と処置する必要があるかもしれない。

(gambol-zebra::zebra-benchmark 1000)
; cpu time (non-gc) 44.780000 sec user, 0.000000 sec system
; cpu time (gc)     38.100000 sec user, 0.000000 sec system
; cpu time (total)  82.880000 sec (00:01:22.880000) user, 0.000000 sec system
; real time  82.874676 sec (00:01:22.874676)
; space allocation:
;  263,790,840 cons cells, 9,367,684,480 other bytes, 0 static bytes
154741.8
→ (?h
   (house norwegian fox kools water yellow)
   (house ukrainian horse chesterfield tea blue)
   (house englishman snails winston milk red)
   (house spaniard dog luckystrike oj ivory)
   (house japanese zebra parliaments coffee green)) 
  (?w . norwegian) 
  (?z . japanese) 

結び

PrologのCommon Lisp実装は他にも結構あるらしいので、見付けたらZebraパズルを試していきたい。


HTML generated by 3bmd in LispWorks 7.0.0

Older entries (2127 remaining)