#:g1

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

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

Common LispのScreamerでZebraベンチ

Posted 2017-06-13 16:22:44 GMT

Screamerとは古くからあるCommon Lispの非決定性計算のライブラリで、知る人ぞ知るという感じのものだが、現在もQuicklisp経由で簡単に導入することが可能。

(ql:quickloda :screamer)

数年前ScreamerでZebraパズルを記述したものがあったので試してみたが、どうも遅いっぽいなあという漠然とした印象だけ残っていた。
最近Zebraパズルばっかりやっているが、無駄な知見が溜りつつある丁度良いタイミングなので果して本当に遅かったのか確認してみることにした(暇ともいう)

筆者が以前目にしたものは、SBCLの開発で有名な、Nikodemus Siivola氏が書いたものだったらしい。

こちらのコードを少しSWI-Prologのコードっぽくして、計時してみた。

(declaim (optimize (speed 3) (safety 0) (debug 0) (compilation-speed 0)))

(eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickloda :screamer))

(in-package :s)

(defmacro let-integers-betweenv (((min max) var-list) body) `(let ,(loop for i in var-list collect (list i `(an-integer-betweenv ,min ,max))) ,body))

(defun all-differentv (list) ;; Functionally the same as (apply #'/=v list), but faster. (labels ((all-different (x xs) (if (null xs) t (andv (notv (=v x (car xs))) (all-different x (cdr xs)) (all-different (car xs) (cdr xs)))))) (all-different (car list) (cdr list))))

(defun nextto (x y) (let ((d (an-integer-betweenv -1 1))) (assert! (/=v d 0)) (assert! (=v d (-v x y)))))

(defun iright (x y) (assert! (=v x (+v y 1))))

(defun zebra-problem () (let-integers-betweenv ((1 5) (english spaniard japanese ukrainian norwegian red green ivory yellow blue dog snails fox horse zebra kools chesterfield winston luckystrike parliament tea coffee milk oj water z w)) (let ((nationality (list english spaniard japanese ukrainian norwegian)) (color (list red green ivory yellow blue)) (smoke (list kools chesterfield winston luckystrike parliament)) (pet (list zebra dog snails fox horse)) (drink (list water tea coffee milk oj))) (assert! (all-differentv nationality)) (assert! (all-differentv color)) (assert! (all-differentv smoke)) (assert! (all-differentv pet)) (assert! (all-differentv drink)) ;; (assert! (=v norwegian 1)) (assert! (=v milk 3)) (assert! (=v english red)) (assert! (=v spaniard dog)) (iright green ivory) (nextto norwegian blue) (assert! (=v kools yellow)) (assert! (=v green coffee)) (assert! (=v ukrainian tea)) (assert! (=v luckystrike oj)) (assert! (=v japanese parliament)) (assert! (=v winston snails)) (assert! (=v z zebra)) (assert! (=v w water)) (nextto horse kools) (nextto fox chesterfield)

(destructuring-bind (z w &rest result) (one-value (solution (list z w nationality pet drink color smoke) (static-ordering #'linear-force))) (let* ((syms '((english spaniard japanese ukrainian norwegian) (zebra dog snails fox horse) (water tea coffee milk oj) (red green ivory yellow blue) (kools chesterfield winston luckystrike parliament) )) (result (apply #'mapcar #'list (mapcar (lambda (x) (mapcar #'second (sort x #'< :key #'first))) (mapcar (lambda (x y) (mapcar #'list x y)) result syms))))) (list (nth 0 (nth (1- z) result)) (nth 0 (nth (1- w) result)) result))))))

(zebra-problem)(japanese norwegian ((norwegian fox water yellow kools) (ukrainian horse tea blue chesterfield) (english snails milk red winston) (spaniard dog oj ivory luckystrike) (japanese zebra coffee green parliament)))

Allegro CL 8.2 64bitで大体210秒位。オリジナルも大体同じ位のスピードで、assert!の節を関数として括り出しても性能的には問題ないようだ。
ちなみに、LispWorksや、SBCLだと130秒位で終了するので、コードの最適化がSBCLやLispWorksに向けて施されているかもしれない。

;(time (dotimes (i 1000) (zebra-problem)))
; cpu time (non-gc) 197.770000 sec (00:03:17.770000) user, 0.010000 sec system
; cpu time (gc)     12.670000 sec user, 0.000000 sec system
; cpu time (total)  210.440000 sec (00:03:30.440000) user, 0.010000 sec system
; real time  210.561596 sec (00:03:30.561596)
; space allocation:
;  74,892,808 cons cells, 70,951,714,176 other bytes, 0 static bytes)

コードの中身としては、これまでのリスト処理のコードとはちょっと違っていて、各要素に1から5までの数値を割り当て、要求された条件に合う解を見付けてくるようなものになっている。
Prologに比べると変数の初期化等のコード量が多く、その辺りの見通しが少し良くない。

なおオリジナルのコードのコメントによると、もう少し速くなる書き方があるらしい。
20倍位速くなればPAIProlog並ということになるが、ここまで手続的に書いてPAIPrologより遅いとなるとZebraのような問題に限っては、組み込みPrologを使った方が楽で良いなと思ってしまう。

結び

いかつい名前から勝手に超高速なものという印象を持っていたが、Zebraに関しては若干期待外れだった。

Screamerが得意とする問題もあると思うので、得意なものもそのうち確認してみたい。


HTML generated by 3bmd in LispWorks 7.0.0

Common LispのminiKANRENでZebraベンチ

Posted 2017-06-09 19:09:28 GMT

Common Lisp上から使える論理型言語・DSLを適当に眺めたりしているが、今回はminiKANRENを試してみる。

miniKANRENとは

KANRENはScheme上に実装された論理型・関係型言語で、名前は日本語の関連(relation)に由来するらしい。
元々miniKANRENはそのサブセットだったようだが、今では一つの流派を成しているようだ。

実装がシンプルなので多数の言語の上で稼動する。最近のもので比較的有名なものとしてClojureのcore.logicがある。

Prologと比較すると、より関数型言語との親和性が高かったり、Occur Checkがあったり、基本的にcutはなかったり色々と違うようだ。

Zebraベンチを走らせてみる

Common LispにもminiKANRENは移植されていて、quicklisp経由で導入することができる。

(ql:quickload :kanren-trs)

とりあえず、毎度試しているSWI-Prolog版のZebraベンチのコードをminiKANRENで書いてみた。

(defpackage :k
  (:use :cl :kanren-trs))

(defun memb (item list) (fresh (a d) (conde ((== '() list) +fail+) ((== (cons item d) list)) ((== (cons a d) list) (memb item d)))))

(defun nextto (x y list) (conde ((iright x y list)) ((iright y x list))))

(defun iright (left right list) (fresh (a d r) (conde ((== '() list) +fail+) ((== (cons a '()) list) +fail+) ((== (cons left d) list) (== (cons right r) d)); left d:(right r) ((== (cons a d) list) (iright left right d)))))

(defun replace-_ (tree) (let ((vars '())) (labels ((frob (tree) (typecase tree (null '()) (atom tree) (cons (case (car tree) (_ (let ((s (gensym))) (push s vars) (cons s (frob (cdr tree))))) (otherwise (cons (frob (car tree)) (frob (cdr tree))))))))) (values (frob tree) vars))))

(defmacro fresh* (&body body) (multiple-value-bind (newbody vars) (replace-_ body) `(fresh (,@vars) ,@newbody)))

(defun zebra (h w z) (fresh* (== h `((norwegian ,_ ,_ ,_ ,_) (,_ ,_ ,_ ,_ ,_) (,_ ,_ ,_ milk ,_) (,_ ,_ ,_ ,_ ,_) (,_ ,_ ,_ ,_ ,_))) (memb `(englishman ,_ ,_ ,_ red) h) (memb `(spaniard dog ,_ ,_ ,_) h) (memb `(,_ ,_ ,_ coffee green) h) (memb `(ukrainian ,_ ,_ tea ,_) h) (iright `(,_ ,_ ,_ ,_ ivory) `(,_ ,_ ,_ ,_ green) h) (memb `(,_ snails winston ,_ ,_) h) (memb `(,_ ,_ kools ,_ yellow) h) (nextto `(,_ ,_ chesterfield ,_ ,_) `(,_ fox ,_ ,_ ,_) h) (nextto `(,_ ,_ kools ,_ ,_) `(,_ horse ,_ ,_ ,_) h) (memb `(,_ ,_ luckystrike oj ,_) h) (memb `(japanese ,_ parliaments ,_ ,_) h) (nextto `(norwegian ,_ ,_ ,_ ,_) `(,_ ,_ ,_ ,_ blue) h) (memb `(,w ,_ ,_ water ,_) h) (memb `(,z zebra ,_ ,_ ,_) h)))

KANRENでは匿名関数がサポートされているように見えるが、miniKANRENではサポートされていないらしい。
毎度freshで手書きで指定するのはあまりにも辛いのでfresh*という適当なマクロを書いてみた。なお入れ子での利用は想定していない。

ちなみにマクロで圧縮しないと、下記のようになる。Zebraのように変数が多いとちょっと辛い。

(defun zebra* (h w z)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (fresh (a1 a2 a3 a4 a5
          b1 b2 b3 b4 b5
          c1 c2 c3 c4 c5
          d1 d2 d3 d4 d5
          e1 e2 e3 e4 e5)
    (== h `((norwegian ,a2 ,a3 ,a4 ,a5)
            (,b1 ,b2 ,b3 ,b4 ,b5)
            (,c1 ,c2 ,c3 milk ,c5)
            (,d1 ,d2 ,d3 ,d4 ,d5)
            (,e1 ,e2 ,e3 ,e4 ,e5)))
    (fresh (t1 t2 t3)
      (memb `(englishman ,t1 ,t2 ,t3 red) h))
    (fresh (t1 t2 t3)
      (memb `(spaniard dog ,t1 ,t2 ,t3) h))
    (fresh (t1 t2 t3)
      (memb `(,t1 ,t2 ,t3 coffee green) h))
    (fresh (t1 t2 t3)
      (memb `(ukrainian ,t1 ,t2 tea ,t3) h))
    (fresh (t1 t2 t3 t4 t5 t6 t7 t8)
      (iright `(,t1 ,t2 ,t3 ,t4 ivory) `(,t5 ,t6 ,t7 ,t8 green) h))
    (fresh (t1 t2 t3)
      (memb `(,t1 snails winston ,t2 ,t3) h))
    (fresh (t1 t2 t3)
      (memb `(,t1 ,t2 kools ,t3 yellow) h))
    (fresh (t1 t2 t3 t4 t5 t6 t7 t8)
      (nextto `(,t5 ,t6 chesterfield ,t7 ,t8) 
              `(,t1 fox ,t2 ,t3 ,t4) h))
    (fresh (t1 t2 t3 t4 t5 t6 t7 t8)
      (nextto `(,t5 ,t6 kools ,t7 ,t8) 
              `(,t1 horse ,t2 ,t3 ,t4) h))
    (fresh (t1 t2 t3)
      (memb `(,t1 ,t2 luckystrike oj ,t3) h))
    (fresh (t1 t2 t3)
      (memb `(japanese ,t1 parliaments ,t2 ,t3) h))
    (fresh (t1 t2 t3 t4 t5 t6 t7 t8)
      (nextto `(norwegian ,t1 ,t2 ,t3 ,t4)
              `(,t5 ,t6 ,t7 ,t8 blue) h))
    (fresh (t1 t2 t3 t4)
      (memb `(,w ,t2 ,t3 water ,t4) h))
    (fresh (t2 t3 t4)
      (memb `(,z zebra ,t2 ,t3 ,t4) h))))

計時

さて、これで、下記のような感じで、いつもと同じAllegro CL 8.2 64bitで1000回繰り返してみた。

(time 
 (dotimes (i 1000)
   (run nil (a)
     (fresh (h w z)
       (zebra h w z)
       (== a (list h w z))))))

; cpu time (non-gc) 216.919057 sec (00:03:36.919057) user, 0.000000 sec system ; cpu time (gc) 23.884974 sec user, 0.000000 sec system ; cpu time (total) 240.804031 sec (00:04:00.804031) user, 0.000000 sec system ; real time 240.977189 sec (00:04:00.977189) ; space allocation: ; 383,627,240 cons cells, 38,243,671,232 other bytes, 0 static bytes

結果は、216秒とかなり遅かった。PAIPrologの約20倍、AZ-Prolog・Allegro Prologと比較すると約250〜300倍遅い。
Common Lispの実装は特に高速化は施されていないのでこんなものなのかもしれない。

ちなみに今回、ウェブ上で散見されるZebraベンチにも色々なバージョンがあることと、述語の並べ方によって10倍以上の速度の違いが生じることがあることに気付いた。
SWI-Prologのベンチでは、家の情報(全体の情報)、水を飲んでいる物、シマウマの所有者の3つの変数を使うが、全体の情報を取得のみの場合もあるようだ。
また、述語の並べ方としては具体的には、

(defun zebra/ (h w z)
  (fresh*
    (== h `((norwegian ,_ ,_ ,_ ,_)
            (,_ ,_ ,_ ,_ ,_)
            (,_ ,_ ,_ milk ,_)
            (,_ ,_ ,_ ,_ ,_)
            (,_ ,_ ,_ ,_ ,_)))
    (iright `(,_ ,_ ,_ ,_ ivory)
            `(,_ ,_ ,_ ,_ green) h)
    (nextto `(norwegian ,_ ,_ ,_ ,_)
            `(,_ ,_ ,_ ,_ blue) h)
    (memb `(englishman ,_ ,_ ,_ red) h)
    (memb `(spaniard dog ,_ ,_ ,_) h)
    (memb `(japanese ,_ parliaments ,_ ,_) h)    
    (memb `(ukrainian ,_ ,_ tea ,_) h)
    (nextto `(,_ ,_ chesterfield ,_ ,_)
            `(,_ fox ,_ ,_ ,_) h)
    (memb `(,_ snails winston ,_ ,_) h)    
    (memb `(,_ ,_ kools ,_ yellow) h)    
    (memb `(,_ ,_ luckystrike oj ,_) h)
    (memb `(,w ,_ ,_ water ,_) h)
    (memb `(,z zebra ,_ ,_ ,_) h)
    (memb `(,_ ,_ ,_ coffee green) h)
    (nextto `(,_ ,_ kools ,_ ,_) 
            `(,_ horse ,_ ,_ ,_) h)))

のような順番で述語を記述すると、約11秒なので20倍程度は速い。
なお、Allegro Prologなどでもこの述語の並びだと10倍程度速くなるようなので、Zebraベンチの場合は述語の並びを揃えないと、うまく比較できないと考えた方が良いようだ。

結び

miniKANRENは親言語とのデータのやりとりも簡単で使い勝手良さそうだ。
miniKANRENといえば、The Reasoned Schemerらしいので、そのうち読んでみたい。


HTML generated by 3bmd in LispWorks 7.0.0

Boizumault本のMini-Prolog-IIでZebraベンチ

Posted 2017-06-02 15:16:36 GMT

先日退職し、またも無職となったが、同僚から餞別でPatrice Boizumault氏のThe Implementation of Prologを頂いた。
これ前から欲しかったので非常に嬉しい!。ありがたや!!。

この本は、タイトル通りPrologを実装していこうという本で、出版は1993年と古いが、WAMベースなPrologをCommon Lispで実装しようというのが、筆者的には魅力の本。

この本のコードはCMUのAIリポジトリにあるので、本はまだ読んでいないが、とりあえずどんなものか動かしてみることにした。

ファイルを展開すると色々とファイルがあるが、Prologの実装の本なので順を追って複雑になっているらしい。
Mini-Prolog-IIが最終版のようなので、こちらを動かすことにする。

$ cd microPrologII/
$ make

とすると、V4.lspというファイルができる。
540行目付近で;の付け忘れがあるので修正しよう。

544c536
<           (push_cont)                 ; saves current cont.
---
>           (push_cont) saves current cont.

さて、このファイルを実行すると

Mini-PrologII

; Loading text file /l/src/rw/mini-prolog-ii/mlg.Start /l/src/rw/mini-prolog-ii/mlg.Start

| ?-

のように初期化ファイルを読み込んでPrologが開始される。S式PrologではなくDEC-10 Prolog文法らしい。

| ?- conc([a,b,c],Xs,[a,b,c,d,e,f]). % conc = append
xs = [d,e,f]
no More

Zebraベンチを走らせる

とりあえず動いたが、ファイルを読み込ませる方法が分からないので、とりあえずLisp側から読み込ませてみることにした。

(defun mp2-load (file)
  (let ((*readtable* mini-prolog-ii::*mini-prolog-ii-readtable*)
        (*package* (find-package :mini-prolog-ii)))
    (load file)))

(mp2-load "zebra.mpl")

という風に読み込ませる。

ベンチのコードは、下記のようにしたが、これまで測定に利用してきたAllegro PrologのページのものをMini-Prolog-IIで動くように調整したもの。

% -*- Mode: prolog -*-
%
% This file for benchmarking against Mini-Prolog-II.
%

$ member(Item, [Item|_]). $ member(Item, [_|T]) :- member(Item, T).

$ nextto(X, Y, List) :- iright(X, Y, List). $ nextto(X, Y, List) :- iright(Y, X, List). $ iright(Left, Right, [Left, Right | _]). $ iright(Left, Right, [_ | Rest]) :- iright(Left, Right, Rest).

$ zebra(H, W, Z) :- eq(H,[house(norwegian, _, _, _, _), _, house(_, _, _, milk, _), _, _]), member(house(englishman, _, _, _, red), H), member(house(spaniard, dog, _, _, _), H), member(house(_, _, _, coffee, green), H), member(house(ukrainian, _, _, tea, _), H), iright(house(_, _, _, _, ivory), house(_, _, _, _, green), H), member(house(_, snails, winston, _, _), H), member(house(_, _, kools, _, yellow), H), nextto(house(_, _, chesterfield, _, _), house(_, fox, _, _, _), H), nextto(house(_, _, kools, _, _), house(_, horse, _, _, _), H), member(house(_, _, luckystrike, oj, _), H), member(house(japanese, _, parliaments, _, _), H), nextto(house(norwegian, _, _, _, _), house(_, _, _, _, blue), H), member(house(W, _, _, water, _), H), member(house(Z, zebra, _, _, _), H).

% This runs the query a single time: % ?- zebra(Houses, WaterDrinker, ZebraOwner). %

$ zebra1(Houses, WaterDrinker, ZebraOwner) :- zebra(Houses, WaterDrinker, ZebraOwner), !.

$ zebran(X,X). $ zebran(N,Limit) :- zebra1(Houses, WaterDrinker,ZebraOwner), plus(N,1,N1),!, zebran(N1,Limit).

実は、調整したといいつつ、Mini-Prolog-IIは匿名変数の_をサポートしていないらしい。
シンボル名が被らないように記述すれば良いが面倒なので処理系を改造することにした。
といっても簡単な改造で、_シンボルだったら(gensym)するというだけのもの。

(defun read_atom (ch)                   ; next normal symbol
  (do ((lch (list ch) (push (read-char) lch)))
      ((not (alphanum (peek-char)))
       (let ((sym (implode (reverse lch))))
         (if (string= "_" sym)
             (gensym "_")
             sym)))))

これで匿名変数がちゃんとサポートできているのかは良く分からないが、とりあえず上手く動いているようだ。

| ?- zebra1(Houses,WaterDrinker,ZebraOwner).
zebraowner = japanese
waterdrinker = norwegian
houses = [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)]
no More

計時

備え付けで、cputimeというものがあるが測定しづらいので、timeという単なる時間を取得する述語を作成し時刻差を計算することにする。

繰り返しには、zebranという任意の回数繰り返すものを作成し利用してみた。
しかし、18回以上回すとオーバーフローするので、15回位の繰り返しとし、1000回繰り返した場合の予測とする。

Allegro Prologと比較したいので、計時プラットフォームはAllegro CL 8.2。

time(S),!,
zebran(0,15),!,
time(E),!,
minus(E,S,Time),!.

を実行すると、15回で大体470msなので、1000回回したら31秒という所だろうか。

過去にZebraベンチを同じ条件で計時したことがあるが、PAIPrologが11秒だったのでその3倍位になる。

最適化宣言をして、それだけで速くなったら儲け物なので、次に下記のような宣言をし、

(declaim (optimize (speed 3) (safety 0) (debug 0) (compilation-speed 0)))

再度計時してみたが、これだけで12.4秒位までは速くなった。大体PAIPrologと一緒のタイムだ。

ちなみに、SBCLでは、10秒、LispWorksでは11秒と若干速くなるらしい。

結び

AZ-Prolog並のスピードを出すAllegro Prologは、PAIPのPAIPrologをチューニングしたものがベースになっているが、元のPAIPrologもまあまあ速いようだ。

Mini-Prolog-IIをいじって高速化できたら楽しいので、The Implementation of Prologを読んでPrologの実装について勉強することにしよう。

なお、今回の計時で利用した一式はGitHubに置いてみてある

関連記事


HTML generated by 3bmd in LispWorks 7.0.0

Common Lispのお宅拝見: CMU Common Lisp篇

Posted 2017-06-01 07:09:45 GMT

今回は、CMU Common Lispのcl-userを眺める。

現在でも開発が続いているCommon Lispの処理系の系列としては、CMU Common Lisp(CMUCL)は、1980年あたりのSpice Lispから連綿と続いており、もうすこしで40年になろうとしている。
CMUCLからフォークしたSBCLの方が現在は開発・利用とも活発だが、この系統はCLtL1がSpice Lispのマニュアルを下敷として作成されていたり、Common Lispの歴史と関係が深い。
他にCMUCLからフォークしたものとしては、商用処理系のScieneer Common Lispがあり、こちらはSBCLと同じく64bit化もされている。

cl-userパッケージの構成

さて、cl-userの構成だが、拡張ユーティリティのextentions(ext)パッケージをuseしている。
extパッケージは、便利関数・マルチプロセッシング・拡張機能等で250位の関数・変数が定義されている。

古くからあるものを一つ紹介するとcollectのようなものがある。

(collect ((acc '(-1)))
  (dotimes (i 10)
    (acc i))
  (acc))(-1 0 1 2 3 4 5 6 7 8 9)

また、CMUCLは、double-doubleというdoubleを二つ使って精度を高めた浮動小数点数形式をサポートしているので、そのあたりの定義がある。

(let ((*read-default-float-format* 'double-double-float))
  (read-from-string "3.14159265358979323846264338327950288419716939937511"))
→  3.1415926535897932384626433832795w0
    52

また面白いのが、2000年代位にAllegro CLの機能を取り込んでいて、階層パッケージがあったり、古くからあるencapsulateを土台としてAllegro CL互換のAdvice機構(fwappers)を構築したりしているらしい(fwrappersはextパッケージにはなく別パッケージ)

さて毎度確認しているtruefalseだが、CMUCLにも実装されていなかった。あれれ。

結び

Common Lisp誕生時から存在する、というか元になったものの一つであるSpice Lispの系統が未だに一番人気があるというのも面白い。


HTML generated by 3bmd in LispWorks 7.0.0

Common Lispのお宅拝見: Kyoto Common Lisp篇

Posted 2017-05-30 12:55:12 GMT

今回は、Kyoto Common Lispのcl-userを眺める。

MACLISP系方言をまとめようというのがCommon Lispの発端であったが、それ故MACLISP系方言に親しんだ人達には暗黙の前提があり作られた処理系にはそれが反映されていた。
Kyoto Common Lisp(KCL)は、新規に開発されたため、そのようなCommon Lisp仕様の暗黙の前提を洗い出し、より堅実な仕様を作ることに貢献したとされている。

そんなKCLだが、KCLからは沢山の支流があり、現在も活発なものの代表例としては、Embeddable Common Lisp(ECL)と、GNU Common Lisp(GCL)位だろうか。
GCLは、KCLからAKCLとなり、そこからGNUに渡った系譜で、ANSI CL化はされないままMaxima等の基盤として現在でも利用されているが、gmpを取り込んだりして開発体勢は死んでいないらしい。
また、ECLは、ANSI CL化された系統でUnicode化もされている。ManKai CL(MKCL)はECLからのフォークでECLに対して独自の味付けをしている、という所だろうか。

cl-userパッケージの構成

さて、cl-userの構成だが、KCLはCLtL1なので、userの構成の述べる。
userの構成は非常にシンプルで、lispをuseしているだけというもの。

ECLはANSI CL化されているが、こちらのcl-usercommon-lispをuseしているだけ。

MKCLは少し独自色があり、mkclパッケージをuseしていて、str+等独自なユーティリティが定義してある。

(str+ "foo" "bar" "baz")
→"foobarbaz"

(make-sequence 'octets 10)
→ #(0 0 0 0 0 0 0 0 0 0)

(type-of (make-sequence 'octets 10))(vector natural8 10)

GCLは、defpackageパッケージをuseしているが、CLtL1にはdefpackageがなかったので、別途defpackageが定義されたパッケージをuseしている。若干ANSI CL化されているとも言えるだろう。

さて毎度確認しているtruefalseだが、KCL系には実装されていなかった。ちょっと残念。

結び

KCL系は何の味付けもないcl-userという結果だったが、KCLらしいといえば、そうなのかもしれない。


HTML generated by 3bmd in LispWorks 7.0.0

Common Lispのお宅拝見: Clozure Common Lisp篇

Posted 2017-05-17 15:54:53 GMT

今回は、Clozure Common Lispのcl-userを眺める。
Clozure CLの系統の歴代の処理系を眺めてみたが、どうやら、cl-userの構成は、Macintosh Common Lisp 2.0(1991)で大まかな所が決まったようだ。

Clozure CLの系統の大まかな流れとしては、1987年にCoralがCoral Common Lispを発売し、間も無くFranzと共同で販売することになり年内に、Macintosh Allegro Common Lisp(MACL)となる。

1991年にMCL 2.0となるが、この頃の販売元はAppleで、言語仕様は、この頃出版されたCLtL2を追い掛けたものとなっている。

CLtL1の仕様では、基本パッケージとして、lispusersystemが必須だったが、ANSでは、common-lispcommon-lisp-userとなり、systemは必須ではなくなった。
名前が変更になった理由は、CLtL1仕様とそれ以降の仕様を一つのイメージに同居させるため等々だったようだが、実際には、lispパッケージをclパッケージという名前にしてしまうことが多かったようだ(Allegro CL、LispWorks等)。

しかし、MCLでは、このLISP-PACKAGE-NAME:COMMON-LISPにきっちり対応したようで、MCL 2.0でばっさりとlispuserを廃止して新しい名前にし、旧パッケージは、(require 'lisp-package)で読み込むようになっている。
(なお、これは現在のClozure CLでも同じ。)

関数の仕様の変更もしっかり反映しているので、

(cl:functionp 'list)
→ nil

(lisp:funcionp 'list) → t

のようにLISP-PACKAGE-NAME:COMMON-LISPで検討されていたことが、そのまま実現できている。

このように対応した処理系は、MCLの他にSymbolics CLがあるが、現在CLtL1時代のコードを動かそうとすると、きっちり分かれていた方が可搬性が高いようだ。

当時は移植性を考えてずるずるとlispclと移行した処理系が多かったのだと思うが、結局、前後の仕様が混ざる結果となり、移植性が損なわれることになったように思える。

ちなみに、1.0系統で利用されていたDresher氏が設計したオブジェクトシステムのObject LISPは削除されMCL 2.0からCLOSが搭載されることになった。

cl-userパッケージの構成

さて、CCL系統がdefpackageした時にデフォルトでuseされるパッケージは、clccl

(defpackage :foo)
→ #<Package "FOO">

(package-use-list :foo)(#<Package "CCL"> #<Package "COMMON-LISP">)

cclパッケージは、もともとcoral clの略なのだと思うが、MCL時代もそのまま使われ続け、さらに、Open MCLが処理系名を変更する際には、cclを活かしてClozure CLとしたので原点回帰した。

そのcclパッケージだが、700〜1000を越えるシンボルがエクスポートされている。
古くからある他の処理系と同じく、かなりのごった煮パッケージだが、ユーティリティや処理系拡張が占めている。
さらにMCL時代は、FREDというEmacsが同梱されていて、これがcclパッケージにいるので、これが大分大きくしているようだ。

MCL 2.0位の時期は、処理系拡張はとにかくcclパッケージに入れるという感じだったようだが、Clozure CLでは、多少分別されるようになったらしい。

また、今回も恒例のユーティリティに定義されていることが多いtruefalseの調査を実施。
確認できる限りでも、Macintosh Allegro Common Lisp 1.2.2(1989)時代からCCLパッケージに存在するらしい。

(mapcar #'true lambda-list-keywords)(t t t t t t t t)
(mapcar #'false lambda-list-keywords)(nil nil nil nil nil nil nil nil)

結び

現在のClozure Common Lispの源流であるCoral Common Lispが登場してから30周年らしい。
Spice LispがIBM RT PC上のMachに移植されCMU Common Lispとなったのが1987年、Allegro CLの最初の実装(TEK Common Lisp)が1986年、最初のCLISPが登場したのが1987年、のようだが、現在も生き残っている処理系が続々と30周年を迎えている。
そもそも生き残っているというのが凄いが。


HTML generated by 3bmd in LispWorks 7.0.0

Older entries (2122 remaining)