letS*への道 — #:g1

Posted 2010-11-05 14:28:00 GMT

Seriesに先行するLetSには、letS*(レットエススター)というletを踏襲した構文があります。
このletS*の束縛部では、Series(LetSでいうsequence)を束縛することができます。
動作的には、

(defparameter *alist*
  '((A . 0) (B . 1) (C . 2) (D . 3) (E . 4) (F . 5) (G . 6) (H . 7) (I . 8)
    (J . 9) (K . 10) (L . 11) (M . 12) (N . 13) (O . 14) (P . 15) (Q . 16)
    (R . 17) (S . 18) (T . 19) (U . 20) (V . 21) (W . 22) (X . 23) (Y . 24)
    (Z . 25)))

(defun square-alist (alist) (letS* ((entry (Elist alist)) (square (* (cdr entry) (cdr entry)))) (Rlist (cons (car entry) square))))

(letS* (((key . val) (Elist (square-alist *alist*))) (key (symbol-name key)) (val (format nil "~@R" (1+ val)))) (Rlist (cons key val))) ;=> (("A" . "I") ("B" . "II") ("C" . "V") ("D" . "X") ("E" . "XVII") ("F" . "XXVI") ; ("G" . "XXXVII") ("H" . "L") ("I" . "LXV") ("J" . "LXXXII") ("K" . "CI") ; ("L" . "CXXII") ("M" . "CXLV") ("N" . "CLXX") ("O" . "CXCVII") ; ("P" . "CCXXVI") ("Q" . "CCLVII") ("R" . "CCXC") ("S" . "CCCXXV") ; ("T" . "CCCLXII") ("U" . "CDI") ("V" . "CDXLII") ("W" . "CDLXXXV") ; ("X" . "DXXX") ("Y" . "DLXXVII") ("Z" . "DCXXVI"))

のようなことができます。
Seriesを束縛できるだけでなく、分配束縛機能もあるという優れもの。

さて、このletS*を再現してみようと思ったのですが、色々と難しいところがあります。
まず、square-alistの束縛部のsquareとentryを比べてもらうと分かるのですが、entryはSeriesを束縛していて、squareは、entryの要素にアクセスする格好になっています。
SERIES::*SERIES-IMPLICIT-MAP*を知る前は、どうやって解析したものやらと思ったのですが、これはSERIES::LETの機能にのっかれば簡単にできそうです。
加えて分配束縛機能ですが、これは、DESTRUCTURING-BINDを使えば良いだろうと思いました。
ということで、マクロを組んでいったのですが、Seriesでは、LETやMULTIPLE-VALUE-BINDは用意しているもののDESTRUCTURING-BINDは用意していない様子。
これは、SeriesがDESTRUCTURING-BINDが導入されたCLtL2より前から存在するからかもしれないと思っているのですが、それはさておき、DESTRUCTURING-BINDはLETやMULTIPLE-VALUE-BINDがあれば作れそうなので、処理系のコードを利用し、その中のLETや、MULTIPLE-VALUE-BINDをSERIES::LETや、SERIES::MULTIPLE-VALUE-BINDに書き換えて偽物を作成。
DESTRUCTURING-BINDはSeriesのコードの中では利用されていたので、衝突を回避してdestructuring-bindSという名前で導入することにしました。
そんなこんなで、letS*は
(defmacro letS* (binds &body body)
  (if (endp binds)
      `(progn ,@body)
      (let ((bind (car binds)))
        (if (consp (car bind))
            `(series::destructuring-bindS ,(car bind)
                                          ,(cadr bind)
               (letS* ,(cdr binds)
                 ,@body))
            `(series::let ((,(car bind) ,(cadr bind)))
               (letS* ,(cdr binds)
                 ,@body))))))
のように定義できました。
コードは汚いですが、
-(https://github.com/g000001/series-ext)
にあります。
SERIES::*SERIES-IMPLICIT-MAP*がTでないと機能しませんが、とりあえずは、良しとして、Seriesの理解が深まったら対策したいと思っています。

comments powered by Disqus