#:g1: frontpage

 

Common Lispのdelete-duplicatesの謎

Posted 2015-05-27 15:13:53 GMT

 先日C++のSTLにCommon Lispの影響があるのか探っていましたが、その際に、Stepanov氏が書いたAdaのライブラリを眺めたりしていました。
なんとなく、delete-duplicatesの実装をCommon Lispで書き直して遊んだりしていましたが、適当にベンチを取ってみたところ、Adaのライブラリの方が大分速いことに気付きました。
コードはこんな感じです。

AdaのDelete_Duplicates

function Delete_Duplicates(S : Cell)
       return Cell is 
  Tail, To_Be_Done, I : Cell := S;
begin
  if not Is_End(To_Be_Done) then
    Advance(To_Be_Done);
    while not Is_End(To_Be_Done) loop
      I := S;
      while I /= To_Be_Done and then not Test(I, To_Be_Done) loop
        Advance(I);
      end loop;
      if I = To_Be_Done then
        Tail := To_Be_Done;
        Advance(To_Be_Done);
      else
        I := To_Be_Done;
        Advance(To_Be_Done);
        Set_Next(Tail, To_Be_Done);
        Free(I);
      end if;
    end loop;
  end if;
  return S;
end Delete_Duplicates;

Common Lispに移植したもの

(defpackage :Ada-Generic-Library
  (:use)
  (:nicknames :agl))

(defmacro free (cell) `(setq ,cell nil))

;;; 素直にCommon Lispに写してみたもの (defun agl::delete-duplicates (s &key (test #'eql)) (let ((tail s) (to-be-done s) (i s)) (declare (list i)) (unless (endp to-be-done) (pop to-be-done) (do () ((endp to-be-done)) (setq i s) (do () ((or (eq i to-be-done) (funcall test (car i) (car to-be-done)))) (pop i)) (cond ((eq i to-be-done) (setq tail to-be-done) (pop to-be-done)) (T (pop to-be-done) (setf (rest tail) to-be-done))))) s))

;;; わかりづらいのでprogでlispでの手続き型スタイルで書き直したもの
(defun agl::delete-duplicates (s &key (test #'eql))
  (let ((to-be-done s))
    (unless (endp to-be-done)
      (pop to-be-done)
      (prog ((tail s)
             (i s))
            (declare (list i))
         L0 (cond ((endp to-be-done) (return)))
            (setq i s)
         A  (when (eq i to-be-done)
              (go L1))
            (when (funcall test (car i) (car to-be-done))
              (go L2))
            (pop i)
            (go A)
         L1 (setq tail to-be-done)
            (pop to-be-done)
            (go L0)
         L2 (pop to-be-done)
            (setf (rest tail) to-be-done)
            (go L0)))
    s))

速度を比較

組み込み版 delete-duplicates

(defvar *list* (loop :repeat 1000000 :collect (random 100)))

(let ((u (copy-list *list*))) (length (print (time (delete-duplicates u))))) ;>> ;>> (38 96 43 72 93 25 92 76 46 24 89 51 4 73 86 66 60 42 94 82 84 85 18 68 7 91 16 ;>> 53 26 78 58 71 8 98 28 31 83 19 14 87 49 10 34 95 48 17 13 56 3 29 88 23 64 2 ;>> 39 27 11 62 0 12 44 55 41 59 80 47 30 74 1 52 79 5 9 45 75 69 35 50 99 6 21 61 ;>> 33 63 37 22 15 54 77 70 65 97 90 32 57 36 40 81 20 67) ;=> 100 #|------------------------------------------------------------| Evaluation took: 0.851 seconds of real time 0.860000 seconds of total run time (0.860000 user, 0.000000 system) 101.06% CPU 2,802,049,683 processor cycles 0 bytes consed

Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz |------------------------------------------------------------|#

Adaのものを移植したもの

(let ((u (copy-list *list*)))
  (length (print (time (agl::delete-duplicates u)))))
;>>
;>>  (92 10 43 64 23 0 55 11 62 66 1 21 60 95 90 51 74 49 85 28 45 99 39 12 63 48 83
;>>   88 31 54 14 70 37 18 26 8 61 42 29 81 71 80 57 17 82 58 24 9 87 27 20 46 25 86
;>>   34 97 7 36 89 33 68 93 53 91 41 67 76 79 6 2 98 56 3 5 35 15 16 72 44 77 96 50
;>>   84 73 94 47 30 40 22 38 65 19 13 59 52 4 69 78 32 75) 
;=>  100

#|------------------------------------------------------------|
Evaluation took:
  0.299 seconds of real time
  0.308000 seconds of total run time (0.308000 user, 0.000000 system)
  103.01% CPU
  982,068,177 processor cycles
  0 bytes consed

Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz |------------------------------------------------------------|#

実に3倍近くの差があります。
これだけ速度が違うと気になるので、SBCLの実装と比較してみます。

(defun list-delete-duplicates* (list test test-not key from-end start end)
  (declare (fixnum start))
  (let ((handle (cons nil list)))
    (declare (truly-dynamic-extent handle))
    (do ((current (nthcdr start list) (cdr current))
         (previous (nthcdr start handle))
         (index start (1+ index)))
        ((or (and end (= index (the fixnum end))) (null current))
         (cdr handle))
      (declare (fixnum index))
      (if (do ((x (if from-end
                      (nthcdr (1+ start) handle)
                      (cdr current))
                  (cdr x))
               (i (1+ index) (1+ i)))
              ((or (null x)
                   (and (not from-end) end (= i (the fixnum end)))
                   (eq x current))
               nil)
            (declare (fixnum i))
            (if (if test-not
                    (not (funcall test-not
                                  (apply-key key (car current))
                                  (apply-key key (car x))))
                    (funcall test
                             (apply-key key (car current))
                             (apply-key key (car x))))
                (return t)))
          (rplacd previous (cdr current))
          (setq previous (cdr previous))))))

 Stepanov氏のものでは、アルゴリズムは、

  • N番目の要素を先頭からN - 1番目までの要素と比較して重複があれば、N番目の要素を削除、重複が無ければNを一つ進める

という風になっていますが、Common Lispのものは、

  • N番目の要素をN+1以降のものと比較し、重複していれば、N番目の要素を削除、重複が無ければNを一つ進める

という風に微妙に違っていますが、Stepanov氏のもののように生き残りのリストを伸ばして行く方が、重複がそれなりにある場合は、比較するリストが短かくて済むので速いようです。

from-end Tの有無でのアルゴリズムの違い

 Stepanov氏のアルゴリズムでは、仕組みからして初出の要素が残りますが、Common Lispのものは後が残ります。
どうもCommon Lisp版にもコードが似ている所があるので、初出の要素が残るfrom-end Tのルートを確認してみたところ、なんと、from-end T が付けば、Stepanov氏のアルゴリズムと同じ動作になるので速度も向上します。

(let ((u (copy-list *list*)))
  (length (print (time (delete-duplicates u :from-end T)))))
;>> (92 10 43 64 23 0 55 11 62 66 1 21 60 95 90 51 74 49 85 28 45 99 39 12 63 48 83
;>>  88 31 54 14 70 37 18 26 8 61 42 29 81 71 80 57 17 82 58 24 9 87 27 20 46 25 86
;>>  34 97 7 36 89 33 68 93 53 91 41 67 76 79 6 2 98 56 3 5 35 15 16 72 44 77 96 50
;>>  84 73 94 47 30 40 22 38 65 19 13 59 52 4 69 78 32 75)
;=> 100

#|------------------------------------------------------------|
Evaluation took:
  0.416 seconds of real time
  0.432000 seconds of total run time (0.432000 user, 0.000000 system)
  103.85% CPU
  1,367,069,115 processor cycles
  0 bytes consed

Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz |------------------------------------------------------------|#

ちなみに、srfi-1のdelete-duplicates!の場合は、後続の処理対象のリストから重複を除いて行くので、生き残りリストを比較する方式と同じ位速いようです。また、こちらも初出が残ります。

(define (delete-duplicates! lis &optional (elt= equal?))
  (let recur ((lis lis))
    (if (null-list? lis) 
        lis
        (let* ((x (car lis))
               (tail (cdr lis))
               (new-tail (recur (delete! x tail elt=))))
          (if (eq? tail new-tail) lis (cons x new-tail))))))

(let ((u (copy-list *list*)))
  (length (print (time (srfi-1:delete-duplicates! u #'eql)))))
;>> (92 10 43 64 23 0 55 11 62 66 1 21 60 95 90 51 74 49 85 28 45 99 39 12 63 48 83
;>>  88 31 54 14 70 37 18 26 8 61 42 29 81 71 80 57 17 82 58 24 9 87 27 20 46 25 86
;>>  34 97 7 36 89 33 68 93 53 91 41 67 76 79 6 2 98 56 3 5 35 15 16 72 44 77 96 50
;>>  84 73 94 47 30 40 22 38 65 19 13 59 52 4 69 78 32 75)
;=> 100
#|------------------------------------------------------------|
Evaluation took:
  0.349 seconds of real time
  0.356000 seconds of total run time (0.356000 user, 0.000000 system)
  102.01% CPU
  1,150,623,360 processor cycles
  0 bytes consed

Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz |------------------------------------------------------------|#

なぜ最後のものを残すのか

 delete-duplicatesを使う場合、順番を気にする場合は後の方を消したいことが多く、大概 from-end T を付けますが、なぜ最後のものを残してかつ遅いものが標準となったのか謎です。
また、from-end T というオプションの名前も内部の処理のイメージから乖離している気がしなくもありません。

まとめ

 後を残す方が速い実現方式が過去にはあったのか、それとも後を残したいというニーズが高かったのかは、今後Common Lispの謎の一つとして調べて行きたいと思います。

何かご存知の方は教えて頂けると嬉しいです!


HTML generated by 3bmd in SBCL 1.2.11

HURDでCommon Lisp

Posted 2015-05-25 15:56:24 GMT

GNUプロジェクト純正のOSといえば、GNU/HURDですが、1996年に待望の0.0がリリースされてから早19年。
遅々として開発が進まないことで有名になってしまいましたが、そんなGNU/HURDの0.6が先日リリースされました。
GNU/HURDでは、CLISPが動くことを確認していましたが、今回新リリースということで手順を再確認してみたいと思います。

インストールイメージをダウンロード

GNU/HURDにもLinuxのようにディストロがあったりしますが、元祖という感じのDebian GNU/HURDで進めたいと思います。
ISOイメージは下記からダウンロード可能です。

最小構成の debian-hurd-2015-i386-NETINST-1.iso を利用することとします。

仮想マシンを用意

QEMU等だとディスクイメージを配布しているようですが、以前試した所では、どうもQEMU上のHURDは遅かったのでVirtualBoxで試してみることにしました。
仮想マシンを作成して、ISOイメージをセットし、Debianのインストールを進めていくのみです。
途中、aptのダウンロード元の設定でドイツがデフォルトになっていて進まなかったりするかもしれませんが、近所に設定しましょう。

サポートしているハードウェアが少ないHURDですが、VirtualBoxでは、特に何の問題なくインストールも完了しました。

CLISPをビルドする

Debianでは、clispはaptでインストール可能ですが、HURDではパッケージ登録されていない様子。
動かすには、自前でビルドする必要がありますが、依存のライブラリは、build-dep でインストール可能なので楽です。

$ sudo apt-get build-dep clisp

を実行すれば一式揃います。

あとは、clispのソースを取得してビルドするのみです。

起動

Quicklispを導入した後は、こんな感じ

$ clisp
  i i i i i i i       ooooo    o        ooooooo   ooooo   ooooo
  I I I I I I I      8     8   8           8     8     o  8    8
  I  \ `+' /  I      8         8           8     8        8    8
   \  `-+-'  /       8         8           8      ooooo   8oooo
    `-__|__-'        8         8           8           8  8
        |            8     o   8           8     o     8  8
  ------+------       ooooo    8oooooo  ooo8ooo   ooooo   8

Welcome to GNU CLISP 2.49 (2010-07-07) <http://clisp.cons.org/>

Copyright (c) Bruno Haible, Michael Stoll 1992, 1993 Copyright (c) Bruno Haible, Marcus Daniels 1994-1997 Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998 Copyright (c) Bruno Haible, Sam Steingold 1999-2000 Copyright (c) Sam Steingold, Bruno Haible 2001-2010

Type :h and hit Enter for context help.

;; Loading file /home/mc/.clisprc.lisp ... ;; Loading file /l/quicklisp/setup.lisp ... ;; Loaded file /l/quicklisp/setup.lisp ;; Loaded file /home/mc/.clisprc.lisp [1]>

*features*
;=> (:QUICKLISP :ASDF2 :ASDF :ASDF-UNICODE :READLINE :REGEXP :SYSCALLS :I18N :LOOP :COMPILER :CLOS :MOP :CLISP :ANSI-CL :COMMON-LISP :LISP=CL :INTERPRETER :SOCKETS :GENERIC-STREAMS :LOGICAL-PATHNAMES :SCREEN :FFI :GETTEXT :UNICODE
 :BASE-CHAR=CHARACTER :UNIX)

(posix:uname)
;=> #<UNAME :SYSNAME "GNU" :NODENAME "progw" :RELEASE "0.6" :VERSION "GNU-Mach 1.4+git20150409-486/Hurd-0.6" :MACHINE "i686-AT386">

以前はFFIが関係するライブラリが上手く動かせなかったりしましたが、今回試した所上手く行きました。
以前は、HURD側のライブラリの設定に失敗していたのかもしれません。

何かHURDらしいことを試してみる

HURDにはtranslatorというファイルシステムに色々なものを接続する機能がありますが、この機能を利用したhttpfsがあるので、ウェブページをローカルファイルとしてマウントして読み出してみます。
何となく気分を出すために、with-httpfs-translatorというマクロを定義してみます。

(defmacro with-httpfs-translator ((mount-point host) &body body)
  (let ((ret (gensym)))
    `(let ((,ret nil))
       (ensure-directories-exist ,mount-point)
       (ext:run-shell-command
        ,(format nil
                 "settrans -fgap ~A /hurd/httpfs ~A"
                 mount-point
                 host))
       (unwind-protect (setq ,ret (progn ,@body)) 
         (ext:run-shell-command
          ,(format nil "settrans -fg ~A" mount-point))
         ,ret))))

(with-httpfs-translator ("/tmp/gnu/" "www.gnu.org/") (directory "/tmp/gnu/*.*")) ;=> (#P"/tmp/gnu/home.uk.html" #P"/tmp/gnu/home.sq.html" #P"/tmp/gnu/home.ru.html" ; #P"/tmp/gnu/home.pl.html" #P"/tmp/gnu/home.ko.html" #P"/tmp/gnu/home.ja.html" ; #P"/tmp/gnu/home.it.html" #P"/tmp/gnu/home.fr.html" #P"/tmp/gnu/home.es.html" ; #P"/tmp/gnu/home.el.html" #P"/tmp/gnu/home.de.html" #P"/tmp/gnu/home.ca.html" ; #P"/tmp/gnu/home.en.html" #P"/tmp/gnu/index.html")

(with-httpfs-translator ("/tmp/gnu/" "www.gnu.org/") (with-open-file (in (find "index" (directory "/tmp/gnu/*.*") :test #'string= :key #'pathname-name)) (dotimes (i 10) (write-line (read-line in))))) ;>> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" ;>> "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> ;>> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> ;>> ;>> <head> ;>> <!-- start of server/head-include-1.html --> ;>> <meta http-equiv="content-type" content="text/html; charset=utf-8" /> ;>> <link rev="made" href="mailto:webmasters@gnu.org" /> ;>> <link rel="icon" type="image/png" href="/graphics/gnu-head-mini.png" /> ;>> <meta name="ICBM" content="42.355469,-71.058627" /> ;>> ;=> NIL

という風にDRAKMAのようなhttpクライアントが無くても読み出せますが、別に使い勝手は良くありません。

まとめ

HURDでは現在、CLISPの他には、ANSI CLではないもののGCLが動きます。
謎の原因でOSごと落ちたりするので、まともな作業に使うのは難しい気はしますが、HURDでCommon Lispも乙なものです。


HTML generated by 3bmd in SBCL 1.2.11

Common LispとGUI

Posted 2015-05-10 14:23:45 GMT

という質問に回答してみたのですが、最初投稿しようと思った回答には蛇足としてCommon LispとGUIについて書きました。
しかし、書いてみるとちょっと蛇足すぎるかなと思ったので自分のブログに書きます。
ちなみに、ブログだと横道に逸れまくれるので5、6倍位の分量になりました。

Common LispとGUI

対応が手厚かった1980-90年代

 Common LispにはこれまでGUIが無かったのかと言えば、そんなことはなく、1984年の最初のCommon Lispの仕様にはGUI前提の機能があった位です(文字のフォント属性等)。
これは、当初Common Lispが稼動するマシンは、ウィンドウシステム完備の個人用ワークステーション(Altoのようなも)をメインに想定していたからだと思われます。
Altoの後継のStarが出荷されたのが1981年ですが、AltoのLisp版のようなLispマシンが商用として出荷された(Symbolics、LMI)のも同じく1981年と同時期で、SmalltalkとLispは時代の先端を走っていました。

また、オブジェクト指向のシステムFlavorsシステムも主な応用はウィンドウシステムで、mixinやメソッドコンビネーションの有用性は、これらの応用で実証されてきたようなところもあります。

さらに、Common Lispの最初の仕様のCLtL1の参照実装のようなSpice Lispが稼動していたのも、やはりAltoの後継機のようなPERQというマシンで、Spice Lispのデモプログラムにも当然のごとくグラフィックスのデモがあります(現在CMUCLに添付されているものもあり)。

逆に言えば、これくらいのスペックのマシンでなければCommon Lispは動かなかったとも言えますが、とりあえず想定マシンとしては、こんなマシンだったのではないかなと思います。

このような状況だったので、当時の処理系にはほぼGUIのサポートがありますし、Flavorsも含まれています(多分含まれていないのはKCL位です)

X window への対応もかなり古く、MIT X Consortiumができた1987年辺りからLispネイティブな実装としてCLXもあり、Unixワークステーションで稼動する処理系も大抵サポートされていた状況でした。
商用でなかったCMUCLやKCLの利用者は、この辺りからCLXを組み合せて利用したりしていたようですが、なんとなく今の状況に近い感じもします。

LispネイティブなCLIM

 LispネイティブなGUIのツールキットにCLIMというのがありますが、元々は、SymbolicsのウィンドウシステムのDynamic WindowsというものがCommon Lisp化され、共通化されたものです。
Symbolicsをはじめとして、Franz、Lucid、あたりも開発に参加していたようなので1990年代初頭辺りまでは、割合にメジャーなものだったようです。
Symbolics、Allegro CL、Lucid CL、MCLあたりで使えたようですが、これらの名残りとして、現在でもAllegro CLや、LispWorksなど商用処理系ではサポートがあったりはします。
(とはいえ、商用処理系のCLIMはMotifの時代で停滞していたりするので現在は熱心ではないようです。)

総合的に対応しているので快適

 これら対応が手厚かった時代の環境ですが、GUI周りはあまり考えなくても手軽に書けますし、OS周りもそんな感じで、SymbolicsやMCLなどは非常に快適です。
インターフェイスビルダーのようなものも付属してきますし、大抵の処理系にはエディタはEmacsのCommon Lisp実装が付属してきていますが、ソースが付属してくるので、GUIプログラミングのサンプル的な面もあります(Symbolics、LispWorks、MCL等)
簡単に表現すれば、Lisp製のGUIのIDEが標準で付いてくるのが当り前の時代だったと言えます。

対応が手厚くない2000年代以降

 LispWorksやAllegro CL等では処理系に標準でGUIツールキットが付属してきていて今なおサポートされていますが、フリーな処理系で最初からGUIツールキットが含まれていてるものは、MCLの遺産を引き継いでいるMac版のClozure CL位ではないでしょうか。
理由としては、

  • ツールキットを提供する程の開発リソースはない
  • 処理系は大抵マルチプラットフォームだが、マルチプラットフォームなGUIツールキットというものは少ない
  • マルチプラットフォームに対応する開発リソースはない

等々が主なところでしょうか。
鶏と卵問題ですが、こんな感じなのでCommon LispでGUIのプログラミングはあまりしない→さらに対応する必要性が薄れる、という循環な気もします。

まとめ

 色々と歴史があったからと言っても現状寂しい状況じゃんと言われると、その通りなのですが、LispとGUIというものの関係が発展途上なのかというとそうでもなく非常に微妙なものとなっています。
SBCLがGTk決め打ちで良いのでサポートしてくれると色々捗りそうですが、色々厳しいでしょうね。


HTML generated by 3bmd in SBCL 1.2.11

Ultrix 4.0でT 3.1を動かそう

Posted 2015-05-03 09:38:21 GMT

Common Lispの仕様が練られていた1980年代初頭、Common Lispのように実用指向の処理系を作る動きがありました。その名はT。ベースとなるLispはSchemeでした。
製作者の一人であるJonathan Rees氏が、NILプロジェクトに参加していたのでNILの反対のTになったみたいですが、色々と興味深い処理系です。

大枠としては、RRRSからR3RSあたりのSchemeにモジュールの機能と、手続きを主体としたオブジェクト指向的な機能が特徴です。

このTですが、バージョン 3.1がCMUのAIリポジトリ等からダウンロードできるのですが、如何せんリリースされたのが、1990年辺りなので、動かすには当時の環境が必要になります。
入手できるT 3.1のバイナリの対応プラットフォームですが、

  • Dec 3100(PMAX)
  • SunOS 4(Sparc)
  • SunOS 3(m68k)
  • Encore
  • Hp
  • Apollo/Domain
  • Macintosh A/UX
  • Vax Ultrix

というもので、絶滅してしまったプラットフォームが殆どです。

このうち、Sparc版は、SparcのSolaris 10でそのまま動くことを確認しました。
また、m68k SunOS版は、SunOS 4.1.1 で動くことを確認。とはいえ、これは環境を用意するのが面倒です。

そんなこんなでしたが、最近Vax Ultrixがセットアップできることを知ったので、T 3.1を動かすためにSIMH上にUltrix 4.0環境を作ってみることにしました。

Ultrix 4.0 環境をSIMH上に構築

環境構築ですが、以外にも今時のOSのセットアップ位簡単でした。

本当にこの記事の通りに進めば完了です。
※テープのファイルは色々なところでミラーされているので適宜取得します。

等々

自分が利用しているsimh vaxの起動スクリプトはこんな感じです。

sudo setcap cap_net_raw=ep /usr/bin/vax

/usr/bin/vax simhの設定ファイル

Tのプログラムをultrix に取り込む

さてUltrixは準備できましたが、Tのプログラムをどうやって取り込むかです。
一応ネットワークは使えて、外部からrshなども可能ですが、rcpすると処理系が落ちるという事態に遭遇。
この辺りは深追いできそうもないので、テープからの取り込みを試します。
tarのファイルは、そのままでは読めないので、こちらのブログで公開されている、tapewriteというツールをありがたく使わせて頂きます。

$ cat vaxt.tar |./tapewrite >dat.tap

こんな感じで、dat.tapを作成し、simhの設定ファイルで、

att tq0 dat.tap

としてアタッチします。
あとは、Ultrix上から展開するのみです。

$ tar xv
 ...
  ...
   ...

rshできるようになっていれば、外のEmacsからrun-schemeで実行できます。

(run-scheme "rsh ultrixのアドレス ~/bin/t")

T 3.1 (5) VAX11/UNIX  Copyright (C) 1988 Yale University
T Top level
> 

(define (fib n)
  (if (< n 2)
      n
      (+ (fib (-1+ n))
         (fib (- n 2)))))

#{Procedure 1 FIB}

(compile 'fib)

#{Procedure 1 FIB}

(cl 'fib)

(VARIABLES FREE (FIB) EARLY-BOUND () DEFINED () LSET () SET () ERROR () INTEGRATED () LOCAL () UNREFERENCED ()) ;;; 0 IBs queued, 0 IBs unqueued (AS (IB 2) (SDF 1) (ALIGN 1) (MARK 1) (CLEAN 0) (DIRTY 0) (BYTES 28)) 0 D4: .template A D5: movl 2(p),a1 Procedure ^P_1 (lambda (K_0) ...) Return from procedure (K_0 0 FIB) E movl 2(a1),a1 12 mnegl s^$2,s3 15 movl (sp),tp 18 jmp (tp)

label -> hash: ()

(time (fib 20))

virtual time = 0.96 seconds 6765

まとめ

手軽にTを動かしてみたいという場合でホストマシンを所有していない場合は、今回のUltrixを用意してしまう方法が一番手っ取り早いかなと思います。
興味があればお試しあれかし。


HTML generated by 3bmd in SBCL 1.2.11

Visual Studio CodeでCommon Lisp

Posted 2015-04-30 06:56:35 GMT

 MicrosoftがVisual Studio Codeというエディタを発表しましたが、プラットフォームはWindowsに限定されておらず、MacOSXとLinuxにも対応しています。

色々とMicrosoftの新戦略が話題になっていますが、試しにダウンロードして起動してみたところ、対応している言語モードにClojureがありました。
話題になるようなエディタに最初からサポートされているとは、やはり今時の言語Clojure。
しかし、対応しているとはいえ、Clojureのサポートは、JavaScriptやC#等に比べると現時点では手厚くはないようです。

Common Lispに対応させてみよう

 それはさておき、どんな風にClojureの言語モードを実現しているのか中身を眺めてみましたが、resources/app/plugins/vs.language.clojureが本体のようです。
これのclojureの箇所をcommon-lispにでも書き換えれば、Common Lispにも対応できるんじゃないかと思い、安直にresources/app/plugins/vs.language.common-lispを作成して、中身をちょこちょこ書き換えてみましたが、これだけでも、まあまあな感じになりました。

150430160702

syntaxes以下のJSONの中身をいじれば、対応させたいファイルの拡張子、モードの名前位は簡単に紐付けられます。
自分は、

  "fileTypes": [
      "cl",
      "lisp",
      "lsp",
      "asd"
  ],

位にしてみました。

 他にも色々できそうですが、「これはそのうち誰かが綺麗なCommon Lispモードを作るな」と直感したので、他人様の仕事を待つことにしました。

まとめ

 Git 対応等おいしそうな所は全然試してみていないですが、ファイルブラウザとして使うには便利そうですね。


HTML generated by 3bmd in SBCL 1.2.11

S-1 Lisp ≡ S-1 Common Lisp ≡ S-1 NIL

Posted 2015-04-20 15:33:56 GMT

S-1 Lisp のダンプファイルを発見

いつものごとく暇潰しにSaildartのファイルを眺めていたのですが、ふと、いつも眺めるLISP方面ではなく、システムのバイナリのディレクトリを眺めてみていました。

このディレクトリにLisp関係のものはないかなーと探索していた所、S1LISP.DMPというファイル名をみつけました。
これはもしや謎の処理系S-1 Lispなのでは、ということで早速調べてみることにしました。

S-1 Lisp とは

その前にS-1 Lispとはなんぞやという所ですが、S-1 Lispは、完成することがなかった割にはCommon Lisp関係者に関わりが深かったようで、やたら文献に登場してくる処理系です。
しかし、実際の所どんなものだったのかは謎。

S-1 Lispが登場する主な文献としては、S-1 Lispの自体の論文である S-1 Common Lisp Implementation や Gabrielベンチでお馴染の Performance and evaluation of Lisp systems 辺りでしょうか。

S-1 Common Lisp Implementation という名前の論文があるので、S-1 Lispが処理系名かと思いきや、どうもS-1 Lispという名前の様子。
当時Common Lispがこれから出てくるぞという所で宣言も兼ねていたのかもしれませんが、Common Lispとした理由も謎です。

また、他にS-1 NIL という処理系が文献に登場することもあるのですが、この辺りも謎の一つです。

ファイルの中身を確認してみる

さて、これらのファイルが置かれていたSAILは、PDP-10ということで、36bitのマシンです。
そのままダンプしても何かできるわけでもないので、何か文字情報を取得したいわけですが、PDP-10では、6bit〜とよくいわれるように、6bitで文字を表すと、36bitに6文字入るので都合が良かったようです(SCHEMEが6文字になったのもこれに由来)。
ということで、6bit単位の並びを8bitに枠にあてはめて、謎の8進数の羅列をバイナリにして書き出してみましたが、書き出してみたものの、文字列らしき物は発見できず。

どういうことかと思いS-1のバイトの扱いを文献で確認してみましたが、S-1というマシンは、どうも1byteは8bitではなくて、1byteが9bitという世にも珍しい構成のようです。
1byte=8bitのマシン上でどう可視化したら良いのか良く分かりませんでしたが、ビットの構成もどうなっているか分からないので、とりあえずで上位1bitは無視してバイナリとして書き出すことにしてみました。

(defun html-string-data (html)
  (let ((p (chtml:parse html (chtml:make-pt-builder))))
    (flet ((pick (name p)
             (find name (chtml:pt-children p) :key #'chtml:pt-name)))
      (chtml:pt-attrs (pick :pcdata (pick :p (pick :body p)))))))

(defun s1dmp (html outfile) (with-open-file (out outfile :direction :output :element-type '(unsigned-byte 8) :if-exists :supersede) (with-input-from-string (in (html-string-data html)) (loop :for line := (read-line in nil) :while line :do (let* ((*read-base* 8.) (a (read-from-string line nil nil :start 0 :end 3)) (b (read-from-string line nil nil :start 3 :end 6)) (c (read-from-string line nil nil :start 6 :end 9)) (d (read-from-string line nil nil :start 9 :end 12))) (mapc (lambda (b) (mapc (lambda (b) (write-byte b out)) (list #|(ldb (byte 8 8) b)|# (ldb (byte 8 0) b)))) (list a b c d)))))))

(s1dmp (*:http-request "http://www.saildart.org/S1DEB.DMP%5B1,3%5D_blob") "/tmp/s1deb.dmp")

こんな感じでファイルに書き出します。

これでできたバイナリを眺めてみると、“S-1 Lisp with debugging tools.” などという文字列があり、Lispシンボルらしきものも沢山ありました。
S1DEBというのは、どうもデバッグツール付きのS-1 Lispということみたいです。

ということで、折角なので、シンボルを抜き出してみました。

&REST *& **TRACE-FNS** **TRACE-INDEN** **WTA** 
*:ALLOCATE-LOCK *:ARRAY-DEFAULT-LEADER *:BLOCK-IO-STATUS *:CHANGE-STACK-GROUP *:CHANGE-TYPE 
*:CONDITIONAL-SET *:COPY-PROCEDURE *:CURRENT-STACK-GROUP *:FATAL-ERROR *:GC-LOCK 
*:GC-SEGMENT-TABLE *:GC-SPACE-BOTTOM *:GC-SPACE-GC-CONSTRAINT *:GC-SPACE-LISTS *:GC-SPACE-SIZE 
*:GC-SPACE-TOP *:GC-STACK-GROUP *:INTERNAL-CHANGE-STACK *:IO-CHANNEL-LOCK *:IO-CHANNEL-TABLE 
*:IO-TYIPEEK-TABLE *:MAKE-PROCEDURE-HEADER *:MAKE-STACK *:NPTR-TYPEP *:OBARRAY 
*:PROCEDURE-PROTOTYPE *:SYSCALL-ALLOCATE-SEGMENT *:SYSCALL-RELEASE-SEGMENT *:SYSCALL-SET-SEGMENT-ACCESS *:SYSTEMIC-QUANTITIES 
*DEFUN *DEFUN-MACRO *GC-LOG-SEGMENTITOS-PER-SEGMENT* *GC-OVERFLOW* *GC-SPACE-CONSTRAINT* 
*GC-SPACE-LOG-SEGMENT-SIZE* *GC-SPACE-MAX* *GC-SPACE-SUCCESS-RATE* *READ-ONLY-LOAD* *TRACE 
*UNTRACE + +& -& 0P& 
1+& 1-& :ASCII :BINARY :IN 
:OUT :READ :WRONG-TYPE-ARGUMENT <& =& 
>& ALLOCATE-STORAGE-0 ALLOCATE-STORAGE-1 ALLOCATE-STORAGE-2 ALLOCATE-STORAGE-3 
APPLY ASCII-STREAM ASSQ BASE BOOT 
BOOT-FASL BOOT-GC BOUNDP BUILD CAAAAR 
CAAADR CAAAR CAADAR CAADDR CAADR 
CAAR CADAAR CADADR CADAR CADDAR 
CADDDR CADDR CADR CAR CDAAAR 
CDAADR CDAAR CDADAR CDADDR CDADR 
CDAR CDDAAR CDDADR CDDAR CDDDAR 
CDDDDR CDDDR CDDR CDR CEIL& 
CERROR CHANNELS CHAR CHARACTER CLOSE 
COLLECTOR COMPLAIN COND CONS CONS-IN-AREA 
DEB:DISPLAY-SEGMENTITOS DEB:DISPLAY-SEGMENTS DEB:DISPLAY-SEGMENTS-AUX DEB:INTERNAL-TRACE DEB:PP-AUX 
DEB:PP-PAIR DEB:PP-STREAM DEB:PP-SYMBOL DEB:PP-VECTOR DEB:PRINT-POINTER 
DEB:PRINT-POS-FIXNUM DEB:STORAGE DEB:STORAGE-AUX DEB:TRACE-PRINT DEBUG1SAS 
DEBUG2SAS DEBUGGING DEFUN DELQ DIGITP 
DSKDEBUG1SAS DSKDEBUG2SAS DSKGARBG1SAS DSKGARBG2SAS DSKGARBG3SAS 
DSKGARBG4SAS DSKGARBG5SAS DSKGARBG6SAS DSKGARBG7SAS ENTER 
ENVIRONMENT EQ EQUAL EVAL EVAL:MAKE-ENV 
EVAL:SYMEVAL EVCOND EVLIST EVSETQ EXIT 
FAS-OBJECTS FASL FASL-FILE FASL-INTERN FASL-MAKE-ARRAY 
FASL-MAKE-CODE FASL-MAKE-EXTENDED-NUMBER FASL-MAKE-NUMBER FASL-MAKE-PROCEDURE FASL-MAKE-SPECIAL-VECTOR 
FASL-MAKE-STRING FASL-MAKE-SYMBOL FASL-MAKE-VECTOR FASL-MARKABLE-VECTOR FASL-NUMBER 
FASL-QW-TYPE-VECTOR FASL-REPLACER FASL-SPECIAL-VECTOR FASL-STACK-POPPER FASLOAD 
FBOUNDP FERROR FIX-ALL-POINTERS FIXNUM FLOOR& 
FORMAT FOUR-BYTES-TO-STRING FSYMEVAL FUNCTION FUNCTIONP 
GARBAGE GARBG1SAS GARBG2SAS GARBG3SAS GARBG4SAS 
GARBG5SAS GARBG6SAS GARBG7SAS GC-ALLOCATE-SEGMENT GC-INTERNAL 
GC-OVERFLOW-HANDLER GC:COLLECT-GARBAGE GC:DEALLOCATE-SEGMENT GC:DEALLOCATE-UNMARKED-STACKS GC:FIND-ORIGINAL-CODE 
GC:FIRST-UNPURE-SEGMENT GC:FORWARD-OBJECT GC:FORWARD-PC GC:FORWARD-VECTOR GC:FORWARD-WORDS 
GC:FORWARD-WORDS# GC:INTERNAL-ALLOCATE-IN-SPACE GC:MARK-REGISTERS GC:MARK-STACK-FRAME GC:MARK-STACKS-UNCOLLECTED 
GC:NEXT-WORD-IN-SPACE GC:PARTIAL-SPACE-CHANGE-ACCESS GC:R GC:RELEASE-SPACE GC:RENAME-SPACE 
GC:SET-PURIFICATION-BIT GC:SPACE-CHANGE-ACCESS GC:SPECIAL-VECTOR-BYTESIZE GC:SWEEP-PROCEDURE-HEADER GC:SWEEP-SPACE 
GC:SWEEP-STACK GC:TRY-FORWARD-PC GET GET-MORE-STORAGE GOBBLE 
GUESS-SEGMENT-SIZE HAULONG& INCH INITIALIZATION INPUT-STREAM-P 
INSERT-IN-SYM-TAB INTERN INTERNAL:CALL-FUN IO:ABORT-STREAM IO:CLOSE-STREAM 
IO:DECREMENT-TRANSFER-COUNTER IO:FORCE-OUTPUT IO:GET-FREE-CHANNEL IO:INCREMENT-TRANSFER-COUNTER IO:INPUT-BUFFER 
IO:LAP-BLOCK-IN IO:LAP-BLOCK-OUT IO:LAP-CLOSE-FILE IO:LAP-DELETE IO:LAP-GET-ASCII 
IO:LAP-GET-FOUR-QW IO:LAP-GET-NEXT-PTR IO:LAP-OPEN-FILE IO:LAP-PUT-ASCII IO:LAP-TRANSFER-WORDS 
IO:LAP-TYI IO:LAP-TYO IO:OPEN-FILE IO:OPEN-STREAM IO:OUTPUT-FULL-BUFFER 
IO:PUT-IN-BUFFER IO:READ-ASCII-CHARACTER IO:RELEASE-CHANNEL LAMBDA LENGTH 
LIST LIST-TO-STRING LOAD MACROP MAKE-STRING 
MAKE-UNMARKABLE-FIXNUM-VECTOR MAKE-VECTOR MAX& MEMBER MEMQ 
MIN& MOD& MSGFILES NCONC NCONS 
NILINI NON-NEG-FIXNUM NOT NREVERSE NTH 
NTHCDR NULL OPEN OPSYS OUCH 
OUTPUT-STREAM-P PRIN1 PRINC PRINLENGTH PRINLEVEL 
PRINT PRINT:PRINT-ATOM PRINT:PRINT-FIXNUM PRINT:PRINT-FLONUM PRINT:PRINT-STRING 
PROGN PUTPROP QELEASE-SPACE QUOTE READ 
READ-BLOCK READ-FOUR-QW READ-NEXT-PTR READ:READ-ATOM READ:READ-DOTTED-PAIR 
READ:READ-NUMBER READ:READ-STRING READ:SKIP-WHITESPACE RELEASE-SPACE REMAINDER& 
REMPROP RESTARTNIL REVERSE ROUND& RPLACHAR 
S-1 S-1-FASLOAD SAVE-DEBUG SETPLIST SETQ 
SIMULATOR STANDARD-OUTPUT STREAM STREAMP STRING 
STRING-EQUAL STRING-SXHASH STRING-UPCASE SXHASH SYMBOL-PLIST 
SYMTAB-REF TERPRI TOPLEVEL TRACE TRUNC& 
TYI TYIPEEK TYO UNTRACE USED 
VALID-FASL-HEADERP VALID-FASLP VREF VSET

S-1 Lisp は NIL だった

NILを知っている人には、すぐ分かるのですが、抜き出したシンボルには、NIL特有の物が沢山あります。
例えば、*というパッケージ名や、0P&という関数です。 *パッケージは、なんのパッケージかは謎なのですが、どうもグローバルなパッケージのようで、非常に特徴的な名前の0P&は、ZEROPFIXNUM特化版です。

S-1 Lispの歴史によれば、NILの開発チームと共同開発したようなことも書いてありますが、このファイルを眺める限りは、どうもLispのベースはNILだったのではないかと思われます。

ここで、Common LispとNILの関係を整理すると、NILの開発当初にCommon Lispはありませんでしたが、Common Lispがレキシカルスコープを採用したのはNIL由来だったり、NIL自体がCommon Lispの仕様の成長と共にCommon Lispの一実装になってしまいました。
中々混沌とした流れがありますが、S-1 Lispは、NILで、NILはCommon Lispということになれば、S-1 Lisp ≡ S-1 Common Lisp ≡ S-1 NIL という謎もとけた感じです。

まとめ

NILのマニュアルは数年前に公開されたのですが、処理系のソースコードは公になっていません。
いつか公開されれば、S-1、NIL、Common Lispの関係の初期の歴史もはっきりするかなと期待しています。


HTML generated by 3bmd in SBCL 1.2.10

C++ STLにCommon Lispの影響はあるのかを探る旅(2)

Posted 2015-04-18 06:54:53 GMT

前回は、C++ STLにCommon Lispの影響はあるのかをSTLの歴史を遡って先祖にあたるAdaのリストライブラリを眺めてみました
今回は、C++ STLそのものについてですが、とりあえずC++ STLの作者によるレポートがあるので眺めてみます。

この中で、

accumulate is similar to the APL reduction operator and Common Lisp reduce function

という風にCommon Lispに触れてはいますが、影響を受けたようなことは特に記載されていません。

他にも何かないかなと探してみましたが、プレゼン資料でDylanやLispの良いとこ取りをしよう、的なことが書いてあるので、まあ影響があるといえばあるのかもしれません。

Dylanの名前が挙がっているのは若干意外ではありますが、DylanもCommon Lispの影響が非常に強く、シークエンス系に関しては、殆どそのままというか進化形みたいな所ではあります。

いまいちぱっとしませんが、とりあえず前回と同じく表にして眺めてみます。

C++ STL CLそのまま CLとは別名
accumulate REDUCE
adjacent_find
adjacent_difference
binary_search
copy COPY-SEQ
copy_backward
count COUNT
count_if COUNT-IF
equal EQUAL
equal_range
fill FILL
fill_n FILL :START :END
find FIND
find_end FIND :FROM-END T
find_first_of POSITION
find_if FIND-IF
for_each MAPC
genarate_n
generate MAP-INTO
includes SUBSETP ※リストのみ
inner_product
inplace_merge
iter_swap
lexicographical_compare
lower_bound
make_heap
max MAX ※REDUCEと組み合わせ
max_element
merge MERGE
min MIN
min_element
mismatch MISMATCH
next_permutation
nth_element ELT NTH
partial_sum
partial_sort
partial_sort_copy
partition
pop_heap
prev_permutation
push_heap
random_shuffle
remove REMOVE ※ DELETE
remove_copy REMOVE
remove_copy_if REMOVE-IF
remove_if REMOVE-IF ※ DELETE-IF
replace REPLACE
replace_copy
replace_copy_if
replace_if
reverse REVERSE ※ NREVERSE
reverse_copy REVERSE
rotate ROTATEF
rotate_copy
search SEARCH
search_n SEARCH :START1 :END1
set_difference SET-DIFFERENCE ※リストのみ
set_intersection INTERSECTION ※リストのみ
set_symmetric_difference
set_union UNION ※リストのみ
sort SORT
sort_heap
stable_sort stable-sort
stable_partition
swap ROTATEF
swap_ranges ROTATEF+SUBSEQ
transform MAP-INTO
unique DELETE-DUPLICATES
unique_copy REMOVE-DUPLICATES
upper_bound

Adaのリストライブラリ程、そのまんまではないですが、まあまあ機能と名前は被っている風に見えます。
全般的な所ですが、Adaと同じく、C++ STLも破壊的操作が基本のようで、元を変更しない場合には、_COPY 版が用意されているようです。
Common Lispはシークエンス全般ではなくリストに特化した関数の方が充実しているのが、LISPらしいというか古めかしい所。
シークエンス用関数に関しては、範囲指定が取り込まれているのでC++ STLより汎用的な面もあるようです。

まとめ

Stepanov氏の文献にはSchemeという名前は出てくるのですが、Common Lispの名前はあまり出て来ないのが残念です。
まあ、Lispの良いとこ取りをしよう、とプレゼンでも書いていますし、関数の名前と機能もかなり被っていますし、影響はありますいうことで良いのではないでしょうか。
この件について何か良い資料をご存知でしたら是非とも教えて下さい!


HTML generated by 3bmd in SBCL 1.2.10

C++ STLにCommon Lispの影響はあるのかを探る旅(1)

Posted 2015-04-15 17:40:35 GMT

自分は、C++のことは殆ど知らないのですが、関数名にremove_ifや、count_ifset_differenceがあるのを見て、これってCommon Lispに由来してるんじゃないのかなと思っていました。
しかし、C++のBoostは関数型言語に強い影響を受けているという話を耳にすることはあれ、C++ STLががCommon Lispに影響を受けているという話は耳にしたことが無い気がします。

適当にウェブをググってみたりしても、そんな話もないので、大元であるSTL作者の一人 Alexander A. Stepanov氏のWikipediaでの記述や、氏のウェブページを眺めてみたところ、STLの先祖は、Adaのリスト(シークエンス)ライブラリで、そのコンセプトの検証にSchemeが使われたらしいことが分かりました。

A library of generic algorithms in Adaの方には、リストライブラリは、Common Lispをベースにしているという記述もあります。
このページから、このリストライブラリもダウンロードできるので、暇潰しにどれだけCommon Lispに似ているか一覧を作ってみることにしました。

名前は同じものの動作が違っているものには、(※)を付けました。

Ada CLそのまま CLとは別名
Accumulate
Add_Current
Add_First PUSH
Add_Last
Advance POP
Append APPEND
Append_First_N
Attach_To_Tail
Butlast BUTLAST※
Butlast_Copy BUTLAST
Concatenate CONCATENATE※ NCONC
Concatenate_Copy CONCATENATE
Construct
Copy_First_N
Copy_Sequence COPY-SEQ
Count COUNT
Count_If COUNT-IF
Count_If_Not COUNT-IF-NOT
Create
Current
Delete DELETE
Delete_Copy REMOVE
Delete_Copy_Append
Delete_Copy_Duplicates REMOVE-DUPLICATES
Delete_Copy_Duplicates_Append
Delete_Copy_If REMOVE-IF
Delete_Copy_If_Not REMOVE-IF-NOT
Delete_Duplicates DELETE-DUPLICATES
Delete_If DELETE-IF
Delete_If_Not DELETE-IF-NOT
Drop_Head POP
Drop_Tail
Empty NULL
Equal EQUAL
Every EVERY
Find FIND
Find_If FIND-IF
Find_If_Not FIND-IF-NOT
First FIRST
For_Each MAPC
For_Each_2 MAPC
For_Each_Cell MAPL
For_Each_Cell_2 MAPL
Free
Free_Construct
Free_Sequence
Front
Full
Initialize
Invert
Invert_Copy
Invert_Partition
Is_Empty NULL
Is_End ENDP
Is_Not_End
Last LAST※
Length LENGTH
Make_Sequence MAKE-SEQUENCE
Map MAP
Map_2
Map_Copy
Map_Copy_2
Map_Copy_2_Append
Map_Copy_Append
Merge MERGE
Merge_Non_Empty
Mismatch MISMATCH
Next CDR REST
Not_Any NOTANY
Not_Every NOTEVERY
Nth NTH
Nth_Rest NTHCDR
Pop POP
Pop_Front
Position POSITION
Position_If POSITION-IF
Position_If_Not POSITION-IF-NOT
Push PUSH
Push_Front PUSH
Push_Rear
Rear
Reduce REDUCE
Reverse_Append REVAPPEND
Reverse_Concatenate NRECONC
Search SEARCH
Set_Current
Set_First (SETF FIRST) RPLACA
Set_Last
Set_Next (SETF REST) RPLACD
Set_Nth (SETF NTH)
Some SOME
Sort SORT
Split
Subsequence SUBSEQ
Substitute SUBSTITUTE
Substitute_Copy
Substitute_Copy_If
Substitute_Copy_If_Not
Substitute_If SUBSTITUTE-IF
Substitute_If_Not SUBSTITUTE-IF-NOT
Top

このリストでは、双方向リンクリストや、スタック、ベクタのための関数もあるのでCommon Lispのものと対応していないものも散見されますが、Common Lispもリストを含めてシークエンスに関しては、genericな関数が多いので大体同じです。
主な違いとしては、このAdaのライブラリは、副作用ありの処理が標準となっていて、名前もそちらが標準という感じで、コピーを作るものは、なんとか_Copyという名前が付いていることでしょうか。

この表をみる限りでは、Common LispのシークエンスライブラリをAdaに移植したといっても良いような気さえします。

さて、後継のC++ STLではどうなっているのか。続けられたら続きます…。


HTML generated by 3bmd in SBCL 1.2.10

DEFSTRUCTでリストのアクセサをまとめて定義する

Posted 2015-04-12 23:36:59 GMT

defstruct:typeの指定でリストをバックエンドにした構造が定義できますが、この機能を活用することで、リストで構造を定義してしまったコードにまとめてアクセサを作ったり、後々構造体に書き換えたりするのを楽にすることが可能です。
例えば、

(defun create-character (hp mp str vit dex agi atc def buf items)
  (list hp mp str vit dex agi atc def buf items))

(defvar *spopo* (create-character 10 10 10 10 10 10 10 10 10 '("dagger")))

(defun get-vit (chr) (nth 3 chr))

こんな感じにとりあえずで書き始めてしまって、アクセサを作るのが大変だなあとなった場合でも、

(defstruct (chr (:type list)
                (:constructor create-chr (hp mp str vit dex agi atc def buf items))
                (:conc-name "GET-"))
  hp mp str vit dex agi atc def buf items)

(create-chr 10 10 10 10 10 10 10 10 10 '("dagger")) ;=> (10 10 10 10 10 10 10 10 10 ("dagger")) (get-dex *spopo*) ;=> 10

こんな風にdefstructで構造を定義してやることで、アクセサの自動定義の恩恵に与ることができます。

また、場合によっては、リストの部分構造を別途定義することも可能です。

(defstruct (chr-sub-params (:type list)
                           (:initial-offset 2)
                           (:conc-name "GET-SUB-PARAM-"))
  str vit dex agi atc def buf)

(*:iota 10) ;=> (0 1 2 3 4 5 6 7 8 9)

(get-str (*:iota 10)) ;=> 2

(get-sub-param-agi *spopo*) ;=> 10

まとめ

defstructがアクセサを自動定義することについては長短両所がありますが、便利なこともままあります。

ちなみに、1960-70年代のLISPにはデータ構造がリスト位しかなかったため、car、cdr、cadaddr…が連発するコードが多かったようです。
この傾向は、Common Lispが登場してリスト以外の構造の利用が進む1980年中盤位まで続きますが、defstructのリスト関係のオプションが充実しているのも、この辺りの事情がある気がしています。


HTML generated by 3bmd in SBCL 1.2.10

DEFSTRUCTで文字列を扱う

Posted 2015-04-12 23:22:38 GMT

defstruct:typeの指定によりstructure-object以外にもリストやベクタの構造も定義可能ですが、ベクタの方は、処理系依存でベクタのサブタイプを指定することが可能です。

どんな感じかというと、大抵の処理系では、こんな具合です。

(defstruct (milwa (:type (vector character)))
  (x #\Space)
  (y #\Space)
  (z #\Space))

(make-milwa) ;=> " "

(make-milwa :x #\0 :y #\1 :z #\2) ;=> "012"

(milwa-x "012") ;=> #\0

HyperSpecには、

type---one of the type specifiers list, vector, or (vector size), or some other type specifier defined by the implementation to be appropriate.

とあるので、(vector size)と指定してしまいそうですが、大抵の処理系では、(vector type) のようです。
定義からして長さは有限で自明な気もするのでHyperSpecの説明は不思議ではありますね。
まあ、some other type specifierの方を大抵の処理系が採用しているということなのでしょう。

まとめ

DEFSTRUCTで文字列を扱う方法を紹介してみました。
そんなのどこで使うのという思いはあります。


HTML generated by 3bmd in SBCL 1.2.10

Older entries (1925 remaining)