わだばLisperになる

CLでSRFI-30

SRFI, Common Lisp | 19:02 |

CLでSRFIな日々ですが、今回は、SRFI-30 ネスト可能な複数行コメントです。

ずばりのCLの、#| #| ...|# |# と同じなので、CLはSRFI-30対応済なのです。

• SRFI-30
• no title

とりあえず、レポジトリを作成してからソースを読んだりしているため、意味のないリポジトリを作成してしまいました。まあ良いかなと。

■

ツイートする

LET*の星はRMSが考えた?

Common Lisp | 19:51 |

古いLispMのメーリングリスト(info-lispm@mit-ai)を眺めていて発見した、新機能の告知メッセージ

Date: 15 JUN 1980 0023-EDT
From: RMS at MIT-AI (Richard M. Stallman)
Subject: Incompatible change to PROG
To: INFO-LISPM at MIT-AI

Soon PROG will bind all the variables in parallel
instead of sequentially.  This only makes a difference
if you have initializations which depend on other
variables bound by the same PROG.

If you want to bind variables sequentially, use PROG*,
which is presently the same as PROG and will not change.

Old QFASL files will continue to work as before.
The change takes effect only when the program is recompiled.

I plan to create LET* and DO*, which will both do sequential
binding like PROG*, at some time in the future.

これだけでは、PROGの変数が直列に束縛されるものをPROG*にしたのがRMSかどうかははっきりしませんが、LET*はRMSの創案かもしれないですね。

おおー、RMSかー、などと思ってしまいました。こんなことに関心がある人も少ないかと思いますが。

■

ツイートする

CLでSRFI-71

SRFI, Common Lisp | 23:09 |

昨日のSmiley Hackathon #10でちょっと手をつけて挫折していたSRFI-71ですがパターンマッチが上手く行かない理由が分かって動くようになりました。

その原因ですが、Schemeの場合は変数としてtが使われていることは普通なのですが、あまり注意していなかったのでCL:Tが紛れ込んでいて、パターンマッチが意図しない方向にマッチしていたというオチでした (CL:Tは定数なので変数とは違ったマッチになる) 。

さてそのSRFI-71ですが、多値を受けるLET構文の拡張です。

自分が移植したSRFIでも多値があつかえる束縛構文はこれで4つ目な気がするんですが、SRFIでは思いの外同じ分野の提案が繰り返し提案される傾向があるように思います。

■

また、SRFI-71では、unconsや、unlistも一緒に定義されていたりするのですが、ネーミングがなかなか良いなと思いました。

SRFI-11のlet-valuesと違うところといえば、値を受けるところにも (values v ...)という表記を使うことと、values省略して値を並べて書くこともできる、というところでしょうか。

(in-package :srfi-71-internal)

(let (((values x1 x2 . x2+) (values 1 2 3)))
  (cons x1 (cons x2 x2+)))
;=> (1 2 3)

(let ((car cdr (uncons '(1 2))))
  (cons car cdr))
;=> (1 2)

(let (((values car cdr) (uncons '(1 2))))
  (cons car cdr))
;=> (1 2)

(let (((values . args) (unlist '(1 2 3 4 5))))
  args)
;=> (1 2 3 4 5)

ちなみに我等がSRFI-86でも同じような構文がサポートされています

(alet (((values . args) (values-list '(1 2 3 4 5))))
  args)
;=> (1 2 3 4 5)

(alet (((values x1 x2 . x2+) (values 1 2 3)))
  (cons x1 (cons x2 x2+)))
;=> (1 2 3)

■

ツイートする

逆もまたしかり

Common Lisp | 21:35 |

クヌース先生の「goto文を用いた構造的プログラミング」を読んでいて末尾呼び出しはgotoに直せ、また逆も正しい、との記述を読んで、そういえばあまり逆方向のことは考えないなと思ったので試してみました。

単に試してみただけで特にオチはありません…。

試してみる

(loop :for i :from 0 :below 100 :count i)

のマクロの展開系を関数にしたようなgogo

(defun gogo ()
  (declare (optimize (safety 0) (speed 3)))
  (block nil
    (let ((i 0))
      (declare (type (and real number) i))
      (let ((loop-sum 0))
        (declare (type fixnum loop-sum))
        (tagbody
         NEXT-LOOP
           (when (>= i '100)
             (go END-LOOP))
           (when i
             (setq loop-sum (1+ loop-sum)))
           (setq i (1+ i))
           (go NEXT-LOOP)
         END-LOOP
           (return-from nil loop-sum))))))

(gogo)
;=> 100

disassembleしてみる

; disassembly for GOGO
;        XOR ECX, ECX ; no-arg-parsing entry point
;        XOR EDX, EDX
;        JMP L1
; L0:    ADD RDX, 8
;        ADD RCX, 8
; L1:    CMP RCX, 800
;        JL L0
;        MOV RSP, RBP
;        CLC
;        POP RBP
;        RET

上のgogo(loopマクロの展開形)をそのまま再帰呼び出しに変換したようなrecrec

(defun recrec ()
  (declare (optimize (safety 0) (speed 3)))
  (block nil
    (let ((i 0))
      (declare (type (and real number) i))
      (let ((loop-sum 0))
        (declare (type fixnum loop-sum))
        (labels ((NEXT-LOOP ()
                   (when (>= i '100)
                     (END-LOOP))
                   (when i
                     (setq loop-sum (1+ loop-sum)))
                   (setq i (1+ i))
                   (NEXT-LOOP))
                 (END-LOOP ()
                   (return-from nil loop-sum)))
          (NEXT-LOOP))))))

(recrec)
;=> 100

disassembleしてみる

; disassembly for RECREC
;       XOR ECX, ECX ; no-arg-parsing entry point
;       XOR EDX, EDX
;       JMP L2
; L0:   CMP RCX, 800
;       JL L1
;       MOV RSP, RBP
;       CLC
;       POP RBP
;       RET
; L1:   ADD RDX, 8
;       ADD RCX, 8
; L2:   JMP L0

ジャンプの順番と回数が多少違いますが、gogoもrecrecも大体同じものになりました。(まあ、最適化してるからなんですけど…)

めでたしめでたし。

■

ツイートする

CLでSRFI-17

SRFI, Common Lisp | 21:42 |

悶々とSRFI実装をしていますが、今回は、SRFI-17 一般化されたset! です。

Schemeのset!は、CLでいうsetqで、setfではないのですが、setf的に読み出してきた場所に書き込むという一般化された代入を実現するのがSRFI-17です。

• srfi-17.
• no title

動作

(use-package :srfi-17)

(defun (setter car) (list val)
  (rplaca list val))

(let ((list (list 1 2 3 4)))
  (set! (car list) :foo)
  list)
;=> (:FOO 2 3 4)

(let ((list (list 1 2 3 4)))
  (funcall #'(setter car) list :foo)
  list)
;=> (:FOO 2 3 4)

移植について

set!の方は単純にsetfへのエイリアスとすればOKですが、setterはどうしたもんかと悩みます。

(setter foo)という形式は諦めれば良いのですが、処理系依存の(SBCL)の定義を追加して対処してみることにしました。(define-function-name-syntaxで定義可能)

といっても、((setter car) list :car)まで動くようにするのは大変なので(funcall #'(setter car) list :car)程度で妥協。

■

ツイートする

pkg-bind再び

Common Lisp, Zetalisp | 18:28 |

以前Zetalispのpkg-bindをCLで再現するのに挑戦したことがありました。

• ZetalispのPKG-BIND - わだばLisperになる - cadr group

pkg-bindとはどういうものかというと、囲んだ範囲は指定したパッケージ内にin-packageしたような感じに書けるというものです。

(pkg-bind :drakma
  (let ((fun #'http-request))
    (funcall fun "http://example.com")))

これが、

(LET ((DRAKMA::FUN #'DRAKMA:HTTP-REQUEST))
  (FUNCALL DRAKMA::FUN "http://example.com"))

こんな感じに解釈されます。

前回は中途半端な感じでしたが、通勤途中に前回のアプローチを一捻りする方法を思い付いたのでメモ。

■

前回は、パッケージ名を含んだ文字列を作成して、それを元にS式を組み立てましたが、今回は、文字列の作成に、PRINT-OBJECTを使ってみます。

具体的には、シンボルを読んで、あるオブジェクトに変換して、そのプリティプリントが、#.(CL:INTERN "FOO" "CL")という風になるようにします。

あとは、ボディを再帰的に走査して、文字列として出力し、READ-FROM-STRINGし、それをDEFMACROのボディとします。

(defclass intern-form ()
  ((name :initarg :name)
   (package :initarg :package)))

(defmethod print-object ((obj intern-form) stream)
  (format stream
          "#.(CL:INTERN ~S ~S)"
          (slot-value obj 'name)
          (slot-value obj 'package)))

(defun up-symbol (elt pkg)
  (typecase elt
    (symbol
       (let ((name (string elt)))
         (make-instance 'intern-form
                  :name name
               :package (package-name
                         (let ((elt-pkg (symbol-package elt)))
                           (cond ((eq elt-pkg (find-package pkg))
                                  pkg)
                                 ;;
                                 ((and (eq elt-pkg (find-package *package*))
                                       (find-symbol (string elt) pkg))
                                  pkg)
                                 ;;
                                 ('T elt-pkg)))))))
    ;;
    (otherwise elt)))

(defun symbol-to-intern-form (tree pkg)
  (cond ((null tree)
         tree)
        ;;
        ((atom (car tree))
         (let ((elt (car tree)))
           (cons (if (eq 'pkg-bind elt)
                     'pkg-bind
                     (up-symbol elt pkg))
                 (symbol-to-intern-form (cdr tree) pkg))))
        ;;
        ('T (cons (symbol-to-intern-form (car tree) pkg)
                  (symbol-to-intern-form (cdr tree) pkg)))))

(defmacro pkg-bind (pkg &body body)
  `(progn
     ,@(read-from-string
        (write-to-string
         (symbol-to-intern-form body (package-name pkg))))))

pkg-bindはそれほど使う機会もありませんが、他のパッケージからコピペしたコードをとりあえず手元のパッケージ内で動作確認したい場合などにそれなりに便利に使えます。

■

ツイートする

CLでSRFI-9

SRFI, Common Lisp | 16:32 |

適当にSRFI実装をしていますが、今回は、SRFI-9 レコード型の定義 です。

CLでいう構造体かクラスですが、SRFI-9の define-record-typeも定義時にアクセサやモディファイア等を一式作成するものです。

• srfi-9.
• no title

動作

define-record-type の使い方ですが、定義は、

(define-record-type レコード名 コンストラクタ 述語 *(スロット アクセサ名 モディファイア名))

という風に記述します。

;; pairの定義
(define-record-type pair
  (kons x y)
  pair?
  (x kar set-kar!)
  (y kdr set-kdr!))

;; レコードの作成
(defvar kons (kons 1 2))

(pair? kons)
;=> T

(kar kons)
;=> 1

(kdr kons)
;=> 2

(set-kar! kons 100)
;=> 100

kons
;=> #S(PAIR :KAR 100 :KDR 2)

(set-kdr! kons 200)
;=> 200

kons
;=> #S(PAIR :KAR 100 :KDR 200)

上記のpairの定義は、下記のように展開されることにしてみました。

(progn
  (defstruct (pair
               (:constructor kons (x y &aux (kar x) (kdr y)))
               (:predicate pair?)
               (:conc-name ""))
    kar kdr)
  (srfi-9-internal::define-modifier kar set-kar!)
  (srfi-9-internal::define-modifier kdr set-kdr!))

仮引数とスロット名が対応していませんが、アクセサをdefstruct標準の機能で作成しているのでslot名＝アクセサ名となっています。

■

コンストラクタの引数はdefstructにそのまま渡しているので、defstructのラムダリストが使えます。(これはboa lambda listと呼ばれるようです)

(define-record-type foo
  (mkfoo a b &key c)
  foo?
  (a fooa)
  (b foob)
  (c fooc))

(defvar foo (mkfoo 1 2 :c 3))
;=> FOO

foo
;=> #S(FOO :FOOA 1 :FOOB 2 :FOOC 3)

(incf (fooc foo) 100)
;=> 103

foo
;=> #S(FOO :FOOA 1 :FOOB 2 :FOOC 103)

defstructはオプションが豊富で魔窟な感じですが、こういうシンプルに使えるマクロを用意して使ってみるのもありかなと思います。

■

ツイートする

CLでSRFI-4

SRFI, Common Lisp | 22:31 |

必死に願掛けSRFI実装をしていますが、今回は、SRFI-4 一様数値ベクタ型 です。

通常のベクターは要素の型として任意のオブジェクトが取れるのですが、同じ型の数値しか入らないことが予め分かっていたりする場合には、それにフィットした効率の良いベクタを使いたい、というのが、このSRFIの目的のようです。

• srfi-4.
• no title

動作

(u8vector 0)
;=> #U8(0)

#u64(0)
;=> #u64(0)

(make-s8vector 8)
;=> #S8(0 0 0 0 0 0 0 0)

(u8vector? #u8(1 2 3))
;=> T

移植について

#u8(0)等の読み込みには、リーダーマクロを定義することになりますが、#sが構造体で使われているので競合を回避。

また、#U(0 0 0 0 ...)のような表示をするには、プリンタも変更する必要があります。残念ながらprint-objectで定義可能な部分ではないようなので処理系の関数を上書きすることになります。

CLだと、#u16(0 0 0)もu8(0 0 0)も#(0 0 0)と表示されるので区別がつかないんですねー。もちろんオブジェクトはちゃんと型どおりではあるのですが。

■

ツイートする

CLでSRFI-7

SRFI, Common Lisp | 21:46 |

ちまちまとSRFIをCLに移植していますが、今回は、SRFI-7 フィーチャーベースの設定言語 です。

フィーチャーというのは、処理系がサポートしていて読み込める/読み込んでいる、ある機能のことのようですが、SRFI-7はそのフィーチャーの情報を元に、ライブラリを読み込んだり設定するための設定言語とのこと。

Schemeとは全く別の種類の言語、ということですが、混ぜて考えてはいけないことが何かあるのでしょう。

(program...)の中に、requires、files、code、feature-cond等が記述できて、これを組み合わせてライブラリを読み込みます。

requiresは必要とするフィーチャー、filesはロードするファイル名の指定、codeは、設定時に実行するコード、featture-condは、フィーチャーによって実行するものを切り分けるためのcondのようです。

手軽に書けるので、こういうのも悪くないかなと思ったり。

ついでなので、ASDFのSYSTEMを読み込めるように機能を追加してみました。

• srfi-7.
• no title

動作

(program (requires :sbcl))
;=> NIL

(program (files "/tmp/foo.lisp"
                "/tmp/bar.lisp"
                "/tmp/baz.lisp"))
;=> NIL

(program (feature-cond (:sbcl)))
;=> NIL

(program (feature-cond (:sbcl (requires :srfi-1))
                       (:srfi-0 (requires :sbcl))))
;=> NIL

(program
 (feature-cond (:allegro (systems :srfi-0 :srfi-1))
               (:sbcl (systems :srfi-2))))

(program (requires :sbcl)
         (code (print :sbcl))
         (files "/tmp/foo.lisp")
         (feature-cond (:x86-64)))
;->
;   :SBCL
;=> NIL

■

ツイートする

CLでSRFI-6

SRFI, Common Lisp | 16:17 |

ぼーっとSRFIをCLに移植していますが、今回は、SRFI-6 基本的な文字列ポート です。

CLに同じ機能のmake-string-input-stream等があるので、それのエイリアスを定義しただけで終了。

• srfi-6.
• no title

■

ツイートする

CLでSRFI-78

SRFI, Common Lisp | 22:35 |

ぼんやりとSRFIをCLに移植していますが、今回は、SRFI-78 軽量テスト です。

CLにもユニットテストは色々ありますが、SRFIみたいなものである程度標準化されてるというのは良いですね

• srfi-78.
• no title

基本的な使い方は、 checkの中で、式と期待する値を=>を挟んで書く、というシンプルなものです。

例のごとくシンボルの扱いが面倒臭いので、=> ではなく:=>としてみています。

便利機能としては、SRFI-42と組合さったcheck-ecというものが用意されています。

(use-package :srfi-78)

(check (+ 2 2) :=> 4)
;->
;   (+ 2 2) :=> 4 ; correct
;
;=>

(check (+ 2 2) :=> 5)
;->
;   (+ 2 2) :=> 4 ; *** failed ***
;    ; expected result: 5
;
;=>

(check-ec (:range e 100)
          (:let x e)
          (and (< e 50) (< x 50)) :=> t (e x))
;->
;   (LET ((E 50) (X 50))
;     (AND (< E 50) (< X 50))) :=> NIL ; *** failed ***
;    ; expected result: T
;

■

ツイートする

CLでSRFI-48

SRFI, Common Lisp | 19:47 |

だらだらとSRFIをCLに移植していますが、今回は、SRFI-48 中級の書式文字列です。

SRFI-28にもformatがありましたが、48は機能が増えて中級ということです。CLのformatに比べたら、まだまだってことなんでしょうか。

SRFI-42や、86みたいな例もあることですし、今後のSRFIにとんでもない究極のformatが出てくることを期待しています。

しかし、SRFIって意外と似たものが複数提案される傾向があるんですね。

• srfi-48.
• no title

大体CLのformatに似た感じですが、第二引数が文字列だった場合は、文字列が返ってきたりします。

ちなみに、CLのように文字列指示文字列のところに関数を与えることはできません。

面白いと思ったのは、~Hで、ヘルプが表示されるところ。CLだったらドキュメント文字列にするところだと思いますが、Schemeにそういうものはないので一工夫ということなのでしょう。

(srfi-48:format "~H")
;=> "(format [<port>] <format-string> [<arg>...]) -- <port> is T, nil or an output-port
;   OPTION  [MNEMONIC]      DESCRIPTION     -- Implementation Assumes ASCII Text Encoding
;   ~H      [Help]          output this text
;   ~A      [Any]           (display arg) for humans
;   ~S      [Slashified]    (write arg) for parsers
;   ~W      [WriteCircular] like ~s but outputs circular and recursive data structures
;   ~~      [tilde]         output a tilde
;   ~T      [Tab]           output a tab character
;   ~%      [Newline]       output a newline character
;   ~&      [Freshline]     output a newline character if the previous output was not a newline
;   ~D      [Decimal]       the arg is a number which is output in decimal radix
;   ~X      [heXadecimal]   the arg is a number which is output in hexdecimal radix
;   ~O      [Octal]         the arg is a number which is output in octal radix
;   ~B      [Binary]        the arg is a number which is output in binary radix
;   ~w,dF   [Fixed]         the arg is a string or number which has width w and d digits after the decimal
;   ~C      [Character]     charater arg is output by write-char
;   ~_      [Space]         a single space character is output
;   ~Y      [Yuppify]       the list arg is pretty-printed to the output
;   ~?      [Indirection]   recursive format: next 2 args are format-string and list of arguments
;   ~K      [Indirection]   same as ~?
;   "

移植について

参照実装が、一関数で300行越えの塊というところに若干めげそうになりましたが、名前空間の汚染を嫌ったかなにかで一つに纏まっているだけのようなので分解して定義しました。

また、ソースがぶらさがり括弧派のコードで、Schemeにもそういう人はいるんだなと妙に感心。

■

ツイートする

CLでSRFI-10

SRFI, Common Lisp | 19:47 |

きまぐれでCLに移植しているSRFIですが今回は、#,外部フォームです。

• srfi-10.
• no title

#,はリーダーマクロですが、CLの#.(リード時EVAL)に似た感じのものです。

違いとしては、CLの#.は後続の式をEVALしますが、SRFI-10の#,はAPPLYします。

ちなみに、#,はCLtL1やZetalispでは、ロード時評価のリーダーマクロでしたがANSI CLでは、load-time-valueに置き換えられて廃止になっています。

下準備

(srfi-10:enable-read-time-application)
(import 'srfi-10:define-reader-ctor)

;; CLの #.
#.(+ 3 (+ (+ 3 3) 3))
;=> 12

;; SRFI-10の#,
(define-reader-ctor '+ #'+)

#,(+ 3 #,(+ #,(+ 3 3) 3))
;=> 12

そのままでは、式のCDRが再帰的に評価されていかないので#,をネストしたりする必要があります。

■

単純なリード時の評価以外の主な応用としては、構造体などの簡便な表記などがあるようです。

(defstruct foo x y z)

(define-reader-ctor 'foo #'make-foo)

#,(foo :x 1 :z 2 :y 3)
;=> #S(FOO :X 1 :Y 3 :Z 2)

(defstruct bar x y z)

(define-reader-ctor 'bar
  (lambda (x y z) (make-bar :x x :y y :z z)))

#,(bar 1 2 3)
;=> #S(BAR :X 1 :Y 2 :Z 3)

クラスにreader-ctorを定義して、さらにprint-objectも設定してみる

(defclass baz ()
  ((x :initarg :x)
   (y :initarg :y)
   (z :initarg :z)))

(define-reader-ctor 'baz
  (lambda (&rest args)
    (apply #'make-instance 'baz args)))

(defmethod print-object ((obj baz) stream)
  (with-slots (x y z) obj
    (format stream "#,(BAZ :x ~S :y ~S :z ~S)" x y z)))

#,(baz :x 1 :y 2 :z 3)
;=> #,(BAZ :x 1 :y 2 :z 3)

■

移植について

SRFI-10の文献だけだと微妙な挙動が分からなかったためGaucheで動作を確認して大体のところはGaucheと同じような挙動にしました。

関数のルックアップは、シンボルのSYMBOL-FUNCTIONを見るようにもしてみましたが、これもGaucheの動作に合せてdefine-reader-ctorで定義したものだけ引いてくるようにしてみました。

ちなみにctorはconstructorの略のようで、調べてみたらちらほら用例があるようです。catみたいな略し方ですね。

■

ツイートする

CLでSRFI-3

SRFI, Common Lisp | 19:18 |

はてSRFI-3なんか聞いたことないな、という方も多いかもしれませんが、SRFIには没になったものもあり、その番号は欠番となってしまいます。

SRFI-3は記念すべき一番乗りの没SRFIです。

没になったものを移植してどうするんだ、という気もしますが、移植すること自体が目的なのでとりあえず移植。

SRFI-3の内容ですが、セットとしてのリストを扱うライブラリになります。

どうやら、SRFI-1のリストライブラリに吸収合併される形となったため、単独のSRFIとしては成立しなかった模様。

• srfi-3.
• no title

(srfi-1:lset-union #'= '(1 2 3 4) '(1 2 3 4))
;=> (1 2 3 4)

(srfi-3:lset-union #'= '(1 2 3 4) '(1 2 3 4))
;=> (1 2 3 4)

(srfi-3:union '(1 2 3 4) '(1 2 3 4))
;=> (1 2 3 4)

とはいえSRFI-1ともほんのり微妙に違っているところもあったりします。

移植について

大体SRFI-1の移植と同じですが今回は、もう一歩進めてオリジナルの定義の字面は一切変更しないことを目標に、マクロなどでCLとSchemeの差を埋めてみることにしました。

関数定義が結構あり、#'等をどうごまかすかということになりますが、バリューセルにも関数を詰めることで#'を書かなくても良いようにしました。

かなり強引ですが、ソースを変更しなくて良いのは気持ちが良いですね。S式みな兄弟。

■

ツイートする

CLでSRFI-0

SRFI, Common Lisp | 20:29 |

SchemeのRequest For Implementationに意味なくCLで応えている日々ですが、今回は、SRFI-0 フィーチャーベースの条件展開 です。

CLerにはお馴染みの、#+foo #-barという、リードマクロですが、これのScheme版というところです。

CLでは、リード時に作用しますが、SRFI-0では、マクロ展開時に作用します。

• srfi-0.
• no title

(use-package :srfi-0)

(progn
  (cond-expand (:sbcl
                (print 'sbcl?)))
  #+sbcl (print 'sbcl!)
  nil)
;->
;   SBCL?
;   SBCL!
;=> NIL

移植について

CLに移植するにあたり*features*の機能が活かされないのももったいないので*features*内容も参照するようにしてみました。

SRFI-0の参照実装では、パターンマッチのマクロ内で完結するように組まれていてフィーチャーの追加がなんとなく面倒そうに見えたのですが(マクロ内にずらーっと並べて書くんだろうかとか)、Gaucheでは、実行時にフィーチャーが追加できるようにするため伝統マクロで実装されていました。なるほど。

■

ツイートする