オブジェクト指向システムを拡張する際に、痒い所に微妙に手が届かない気がするMOPと、なんでもできるけど安易なメタプログラミングも嫌だなあというマクロで使い分けに迷うことはないでしょうか。

例えばですが、defstructにはアクセサを自動で生成する機能があり、この機能については善し悪しがありますが、defclassで同様のアクセサの自動生成を実装するとします。
さて、こういう場合、MOPで実現するのが良いのか、マクロでやっつけてしまえば良いのか微妙に悩んだりしないでしょうか(自分だけ?)

defclassでアクセサの生成をするということは、定義時には名前が確定しているということで、マクロが担当するのが良い気もします。
しかしクラスに関することなので、MOPを使った方が既存の構文の枠組みで拡張できたりもしそうです。

どっちもどっちなのですが、とりあえずはマクロで書いてみました。
defclass/conc-nameは、defcassに展開されるマクロですが、:conc-nameでアクセサの接頭辞を指定できます。

(defclass/conc-name foo ()
  (x 
   y 
   (z :accessor z))
  (:conc-name foo.))

;;; マクロ展開
===>
(defclass foo ()
  ((x :accessor foo.x)
   (y :accessor foo.y)
   (z :accessor z :accessor foo.z)))

(let ((qqq (make-instance 'foo)))
  (with-slots (x y z) qqq
    (setq x 42 y 43 z 44))
  (incf (foo.z qqq))
  (list (foo.x qqq)
        (foo.y qqq)
        (foo.z qqq)))
→ (42 43 45) 

defclass/conc-name定義

(defun canonicalize-slots (slots)
  (labels ((canonicalize-slot (slot)
             (typecase slot
               ((and symbol (not null)) (list slot))
               (T slot))))
    (mapcar #'canonicalize-slot slots)))
(defun slot-name-conc (prefix name)
  (let ((pkg (etypecase prefix
               ((or null string) *package*)
               (symbol (symbol-package prefix)))))
    (intern (concatenate 'string (string prefix) (string name)) pkg)))
(defun ->conc-name (name)
  (etypecase name
    (null "")
    (symbol (string name))
    (string name)))
(defmacro defclass/conc-name (name superclasses slots &rest class-options)
  (let* ((conc-name-p nil)
         (conc-name (concatenate 'string (string name) "-"))
         (class-options (loop :for opt :in class-options
                              :if (eq :conc-name (car opt))
                              :do (setq conc-name-p T
                                        conc-name (->conc-name (cadr opt)))
                              :else :collect opt)))
    `(defclass ,name (,@superclasses)
       (,@(loop :for s :in (canonicalize-slots slots)
                :when conc-name-p
                :do (setf (cdr (last s)) 
                          (list :accessor (slot-name-conc conc-name (car s))))
                :collect s))
       ,@class-options)))

マクロで実装してみた感想

マクロで書いた場合ですが、今回の場合は、

• defclassの派生構文ができてしまう
• マクロ内でdefclassのオプションを解析するのがめんどくさい

等々が問題かなと感じます。

defclassのオプションを解析するのがめんどくさいのは、defclassの作法に従おうとした結果で、その方が、使い手も類推できて良かろうという判断なのですが、どうせ拡張された構文なので解析しやすそうな構成にすることも可能かなとは思います。
defstructの作法に近付けるなら、

(defclass/conc-name (foo (:conc-name foo.)) ()
  (x 
   y 
   (z :accessor z)))

のようにできるかもしれません。
問題は、defclass/conc-nameはdefstructの作法で書くという情報の取扱がめんどう(使う側の人が色々憶えないといけない)ということです。

利用者の負担を減らすということでは、構文乗っ取り型マクロにしてしまう手もなくはないですが、どうなんでしょう。

(with-conc-name foo.
  (defclass foo ()
    (x 
     y 
     (z :accessor z))))
;; or
(with-accessor-options ((:conc-name foo.)
                        (:foo opt))
  (defclass foo ()
    (x 
     y 
     (z :accessor z))))
...

この場合は、見掛け上defclassが本体に見えますがwith-conc-nameがdefclassフォームを引数として処理することになります。

トリッキーですが派生構文を処理する場合には、defclass/conc-nameのような新しい名前を導入せずに既存の作法を継承できるので、一番スマートな方法だったりするかもしれません。

次回はMOPの作法で考えてみます。

■

HTML generated by 3bmd in LispWorks 7.0.0

たまにCommon Lisp標準が利用するキーワードシンボル一覧が欲しい時がありますが、どこにあるんでしょうか。

とりあえずのところは、HyperSpecのインデックスが利用できると思います。

• Common Lisp HyperSpec: Index

しかし、どこかにキーワードシンボルだけまとめたものがありそうなのですが……。

少し探しても見当らなかったので、HyperSpecを参考に逆引きCommon Lispに記事を作成してみました。

• Common Lisp標準が利用するキーワードシンボル一覧

ちなみに、HyperSpecのものは記事からインデックスを自動生成かなにかをしているようでタイポがあったり、コード例に使われているだけのキーワードシンボルも計上されているようです。

まとめ

エディタの補完機能まわりをカスタマイズしているときに関数が利用するキーワードだけを補完して欲しいのですが、まずは補完対象の一覧が欲しいなと思って、ここに至ります。
ひょっとしたら、ANSI Common Lisp規格票には掲載されていたりするかもと思い確認してみましたが、こちらにも無いようです。うーむ。

■

HTML generated by 3bmd in LispWorks 7.0.0

毎年振り返りのまとめを書いているので、今回も書いてみます。

Lisp的進捗

ここ数年マニアックなLispネタでアドベントカレンダーを開催することで、色々調べたりしてLispのマイナー機能に詳しくなるというのをやっていました。
2017年はお休みしたのですが、若干の悔いが残ったので、2018年は、setfとメソッドコンビネーションネタでやってみました。
毎回これ以上はないなという所まで掘り下げられるので良い勉強になります(多分)。

メソッドコンビネーションに関しては、まだ掘り下げて書けることがありそうなので、そのうちちょっと書いてみたいと思います。

ブログ

今年書いた記事は72記事だったようです。
アドベントカレンダーで50記事位書いたのを除けば、大体二週間に一記事書いたり書かなかったりというところです。
近年、ブログを書く人も大分少なくなりましたが、2019年もそこそこ書いていきたいと思います。

LispWorks

LispWorksを購入してから早三年半ですが、持ち前の吝嗇根性からLispWorksを使い倒すべくメインに使い続けています。

ちなみに、以前は、SBCLをメインに使っていました。
SBCLはコンパイラ優秀で、実行速度からいうとほぼ最速の処理系で、ユーザーも一番多く、その上自由ソフトな処理系ということもあり、これ以外の選択はないだろうという感じでもあるのですが、GUIツールキット、Common Lispと統合された開発環境、出荷機能まで一通り揃っている完成度の高い処理系というとLispWorks、Allegro CL、MCL位しかありません。
Allegro CLは個人で使うにはお値段が謎、MCLはPPC Macと共に過去のものになってしまった等で、現実的な統合環境としてはLispWorks位かなと思います。

また、職場の社内ツールをLispWorksで作成してみたところ、色々な条件がたまたま上手くはまり、現在もLispWorksで開発が進んでいます。

• 社内にLispWorksユーザーがたまたま二人いた
• MacでGUIのアプリが必要だったので、LispWorksのCAPIに詳しい人がプロトタイプを作ってみたら手早くできちゃった

というところで、まさに偶然ですが、折角の機会なので活用していきたいところです。
ちなみに開発は同僚にお任せしているので、たまに思い付きの機能追加をしてみたりする以外では私はほとんど開発してません😺

2019年やってみたいこと

ここ二三年でLispマシンのエミュレータも、CADR、LMI Lambda、Symbolics Open Genera、TI Explorer、等一通り出揃いましたが、あまりキャッチアップできてないので2019年は力を入れようかなと思っています。

あと年末には、コンディションシステムアドベントカレンダーを開催したいので、色々準備しておきたいところです。

過去のまとめ

• #:g1: 2017年振り返り
• #:g1: 2016年振り返り
• #:g1: 2015年振り返り
• #:g1: 2014年振り返り
• #:g1: 2013年振り返り
• #:g1: 2012年振り返り
• #:g1: 2011年を振り返る
• #:g1: 2010年を振り返る
• #:g1: 2009年を振り返る
• #:g1: 今年一年をふりかえる

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp SETF Advent Calendar 2018 25日目 》

メソッドコンビネーションでアドベントカレンダーを開催することを決めてから、もう一品と考えてsetfアドベントカレンダーを開催してみましたが、後半はネタを捻り出すのがきつかったです。

よくよく考えれば、ただの代入機構なので、話題が広げられる余地はあまりないのですが、ファーストクラスの参照を持つLISP方言についてもうちょっと掘り下げて書けたかもしれません(といっても一回分位だと思いますが)

setfアドベントカレンダーのを書いたお蔭で、setfの定義構文の使い分けについて、きっちり把握できたのは収穫かなと思います。

-完-

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 25目 》

メソッドコンビネーションでアドベントカレンダーは無謀かなと思いましたが、果してそれなりに無謀でした。

このアドベントカレンダーでの収穫は、eshamsterさんに define-method-combinationの詳細な解説を書いて頂けたことかなと思います。
今後define-method-combinationを書く際には参照することも多くなるのではないでしょうか。

• define-method-combinationを理解する
• 小ネタ: define-method-combinationで遊ぶ

メソッドコンビネーションについて分かったこと

私的にメソッドコンビネーションについて分かったことを纏めると

• define-method-combinationは、Common Lispには珍しく細部仕様の詰めが甘いらしい
• :aroundはメソッド周囲をletで囲むような使い方をするもので、:afterや、:beforeとは一線を画す(ので同じ感覚で多用するものではなさそう)
• 割とカジュアルに定義して使うことを考えていたらしい(New flavorsあたりの論文では)
• メソッドの分別の単位はメソッド修飾子。なのでクラスの継承関係とは別個に構成可能。かと思えば、メソッドコンビネーションにメソッドを参加させるためにmixinするようなことも行われていたらしい。
• メソッドの組織化全般に使える

位でしょうか。

メソッドコンビネーションは、まだまだ開拓の余地があると思いますので、今後、さらに活用されることを期待しています。

-完-

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 24目 》

前回、MOPでのメソッドコンビネーションAPIの実現は、紆余曲折ありつつ、曖昧なところを残しているらしい、と書きました。
今回は、ANSI CLでは取り入れられなかったMOP仕様の草案である X3J13-88-003R の 1988-03-11 版にメソッドコンビネーションのAPIについての記述があったので、それを実際に動かしてみて、どのような設計方針であったのかを探ります。

なお、X3J13-88-003R の 1988-03-11版はTeXをPDFにしたものがこちらにありますので、適宜参照してください。

• Common Lisp Object System Specification: 3. Metaobject Protocol (1988-03-11)

下準備

シンボル名の競合がありそうなので、専用のパッケージを作成します。

(defpackage X3J13-88-003R
  (:use :cl :c2mop)
  (:shadowing-import-from :c2mop
   :defmethod :standard-class :defgeneric :standard-generic-function)
  (:shadow :define-method-combination))
(in-package :X3J13-88-003R)

メソッドコンビネーションクラスの定義

method-combinationのサブクラスにstandard-method-combinationとsimple-method-combinationが標準で用意されています。
ただ使い分けについてはいまいちはっきりしません。
とりあえず記述をそのままコードにしています。

(defclass x3j13-88-003r-method-combination (method-combination)
  ((name
    :initarg :name
    :reader method-combination-name)
   (order
    :initarg :order
    :reader method-combination-order)
   (operator
    :initarg :operator
    :reader method-combination-operator)
   (identity-with-one-argument
    :initarg :identity-with-one-argument
    :reader method-combination-identity-with-one-argument)
   (documentation 
    :initarg :documentation))
  (:default-initargs
   :name nil
   :order :most-specific-first
   :operator nil
   :identity-with-one-argument nil
   :documentation nil))
(defclass standard-method-combination (x3j13-88-003r-method-combination)
  ())
(defclass simple-method-combination (x3j13-88-003r-method-combination)
  ())
(defclass short-form-method-combination (simple-method-combination) ())

ここでは、x3j13-88-003r-method-combinationをmethod-combinationのサブクラスにしていますが、恐らくこの定義が、method-combinationの定義になる予定だったのでしょう。

ANSI CLのdefine-method-combinationで指定するようなオプションが、method-combinationの方で定義されていることが分かります。

メソッドコンビネーションオブジェクトのメソッド

メソッドコンビネーション名からメソッドコンビネーションオブジェクトを引いてくるのにmethod-combination-objectを定義します。
AMOPのfind-method-combinationとほぼ同じですが、こちらは総称関数は指定しません。
中身のコードは大体想像で書いています。

(defgeneric method-combination-object (name options))
(defmethod method-combination-object ((name (eql nil)) options)
  (class-prototype 'standard-method-combination))
(defmethod method-combination-object ((name (eql nil)) options)
  (class-prototype 'standard-method-combination))
(defmethod method-combination-object 
           ((name (eql 'standard-method-combination)) options)
  (class-prototype 'standard-method-combination))

define-method-combinationの定義

define-method-combinationは、名前を指定するだけでmethod-combination-objectを簡便に定義できるような位置付けになっています。

short-form-method-combinationが決め打ちになっているのですが、意図的なものなのか間違いなのかははっきりしません。

(defmacro define-method-combination (name &key (documentation nil)
                                          (operator name)
                                          (identity-with-one-argument nil))
  `(defmethod method-combination-object
              ((name (eql ',name))
               options)
     (apply (lambda (&optional (order ':most-specific-first))
              (check-type order (member :most-specific-first
                                        :most-specific-last))
              (make-instance 'short-form-method-combination
                             :name ',name
                             :order order
                             :documentation ',documentation
                             :operator ',operator
                             :identity-with-one-argument
                             ',identity-with-one-argument))
            options)))

メソッド呼び出しのフォームを作るユーティリティ

make-method-callというユーティリティがあったようですが、このインターフェイスではメソッドの引数を上手く取り扱えないということで廃止になったようです。

ユーティリティが何もない現在は結局ベタ書している状況ですが、このmake-method-callを使っても大抵は問題はなさそうではあります。

なお、このコードも使用例から想像して書いています。

(defun make-method-call (method-list &key operator identity-with-one-argument)
  (case operator
    (:call-next-method `(call-method ,(car method-list)
                                     ,(cdr method-list)))
    (ohterwise `(,operator 
                 ,@(loop :for m :in method-list :collect `(call-method ,m))))))

大体これくらいの定義ですが、これだけでもメソッドコンビネーションが定義できます。

compute-effective-method

define-method-combinationは、メソッドコンビネーションオブジェクトに名前を付けて登録する程度の役割になっていましたが、代りにcompute-effective-methodが式の組み立てのメインになります。

(defmethod compute-effective-method (generic-function
                                     (mc short-form-method-combination)
                                     methods)
  (let ((primary-methods (remove (list (slot-value mc 'name))
                                 methods :key #'method-qualifiers
                                 :test-not #'equal))
        (around-methods (remove '(:around)
                                methods :key #'method-qualifiers
                                :test-not #'equal)))
    (when (eq (slot-value mc 'order) ':most-specific-last)
      (setq primary-methods (reverse primary-methods)))
    (dolist (method (set-difference methods
                                    (union primary-methods around-methods)))
      (error "The qualifiers of ~S, ~:S, are not ~S or ~S"
             method (method-qualifiers method)
             (list (slot-value mc 'name)) '(:around)))
    (make-method-call `(,@around-methods
                        (make-method 
                         ,(make-method-call primary-methods
                                            :operator (slot-value mc 'operator)
                                            :identity-with-one-argument
                                            (slot-value mc 'identity-with-one-argument))))
                      :operator :call-next-method)))

メソッドを定義してみる

ではメソッドを定義して動作を確認してみましょう。
総称関数の:method-combination指定が構文チェックでエラーになったりするのでensure-generic-functionを直に使ってみます。

(define-method-combination foo :operator :call-next-method)
(ensure-generic-function 
 'zot 
 :lambda-list '(x)
 :method-combination (method-combination-object 'foo nil))
;; ≡ (defgeneric zot (x))
;;
;;    (setf (generic-function-method-combination #'zot)
;;          (method-combination-object 'foo nil))

(defmethod zot foo (x) (list :p x))
(defmethod zot foo ((x integer)) (list :p 'integer (call-next-method)))
(defmethod zot :around (x) 
  (list :around (call-next-method)))

(zot 8)
→ (:around (:p integer (:p 8))) 

• メソッドコンビネーション展開

(compute-effective-method #'zot 
                          (method-combination-object 'foo nil)
                          (compute-applicable-methods #'zot (list 8)))
→
(call-method
 #<standard-method zot (:around) (t) 41E012FF53>
 ((make-method
   (call-method
    #<standard-method zot (foo) (integer) 41E012FCDB>
    (#<standard-method zot (foo) (t) 41E01306C3>))))) 

上手く動いているようです。

まとめ

以上、X3J13 88-003Rでの定義でしたが、それなりにすっきり纏まっている気がします。
define-method-combinationの:argumentsオプションについては触れられていないのですが、compute-discriminating-functionの祖先の定義お眺める限りは、compute-discriminating-functionがcompute-effective-methodの内容を元に関数オブジェクトを生成する際、総称関数の引数と連結するスコープを差し込むつもりだったのかなと想像しています。

(generic-function (gf-args ...)
  ((lambda (args ...) ;;; define-method-combination の :arguments
     ,@effective-method)
   gf-args ...))

謎が多い、define-method-combinationまわりですが、MOPベースだったら、もうちょっとカスタマイズされたメソッドコンビネーションも活用されていたかもしれません(そうでもないか)

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp SETF Advent Calendar 2018 24日目 》

これまでも何度かget-setf-expansionや、define-setf-expanderを利用する例を取り上げてきましたが、返り値が5つもあります。
そのお蔭で、多値の何番目がなんの役割だったか毎度調べたりしていますが、これだとちょっと面倒なので、専用構文を作って開発環境のシンタックス補完等の恩恵に与る作戦を考えました。

まずは、get-setf-expansionですが、キーワード引数ならぬ、キーワード多値で値を返すことにしてみました。

(defun get-setf-expansion* (place &optional env)
  (multiple-value-bind (vars vals store-vars writer-form reader-form)
                       (get-setf-expansion place env)
    (values :vars vars
            :vals vals
            :store-vars store-vars
            :writer-form writer-form
            :reader-form reader-form)))

• 素のget-setf-expansion

(get-setf-expansion '(ldb bytespec i))
→ (#:g255423) 
   (bytespec) 
   (#:g255424) 
   (let ((#:|Store-Var-255422| (dpb #:g255424 #:g255423 i)))
     (setq i #:|Store-Var-255422|)
     #:g255424) 
   (ldb #:g255423 i) 

• 拡張したget-setf-expansion*

(get-setf-expansion* '(ldb bytespec i))
→ :vars 
   (#:g255429) 
   :vals 
   (bytespec) 
   :store-vars 
   (#:g255430) 
   :writer-form 
   (let ((#:|Store-Var-255428| (dpb #:g255430 #:g255429 i)))
     (setq i #:|Store-Var-255428|)
     #:g255430) 
   :reader-form 
   (ldb #:g255429 i) 

返り値に注釈が付けば、位置とその役割を忘れても大丈夫です。

次に、このキーワード多値を受ける構文を考えてみました。

(defmacro setf-expansion-bind 
          ((&key vars vals store-vars writer-form reader-form)
           setf-expansion-form
           &body body)
  (loop :for (k . v) :in `((:vars . ,vars)
                           (:vals . ,vals)
                           (:store-vars . ,store-vars)
                           (:writer-form . ,writer-form)
                           (:reader-form . ,reader-form))
        :when v :collect `((,k ,v)) :into key-args
        :finally (return 
                  `(macrolet ((setf-expansion-values (&key vars vals store-vars writer-form reader-form)
                                `(values ,vars ,vals ,store-vars ,writer-form ,reader-form)))
                     (multiple-value-call 
                         (lambda (&key ,@key-args &allow-other-keys) 
                           ,@body)
                       ,setf-expansion-form)))))

ボディの中では、setf-expansion-valuesオペレーターで注釈付きで多値を記述できるようにしてあります。

(setf-expansion-bind (:vars vars 
                      :vals vals
                      :store-vars store-vars
                      :writer-form writer-form
                      :reader-form reader-form)
                     (get-setf-expansion* '(ldb bytespec i))
  (setf-expansion-values :vars vars 
                         :vals vals
                         :store-vars store-vars
                         :writer-form writer-form
                         :reader-form reader-form))
→ (#:g255477) 
   (bytespec) 
   (#:g255478) 
   (let ((#:|Store-Var-255476| (dpb #:g255478 #:g255477 i)))
     (setq i #:|Store-Var-255476|)
     #:g255478) 
   (ldb #:g255477 i) 

記述は面倒ですが、たまにしか使わないのとキーワードによる注釈が付くので扱いやすい気がします。
ごちゃごちゃしたキーワード引数はSLIME等でまとめて補完可能なので手打ちする必要はありません。

まとめ

今回は、構文定義 & IDEでの補完 の組み合わせで考えてみましたが、get-setf-expansionのフォームをmultiple-value-bindのフォームで包むような補完ができるIDEの拡張を作ってみても良いかなと思ったりしています。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp SETF Advent Calendar 2018 23日目 》

あと三回setfネタで記事を書かないといけないのですが、何が書けるでしょうか。

とりあえず、今回はsetfのような代入構文をさらに便利にしたような構文を紹介してみたいと思います。

自己代入系

これまで自己代入系の定義構文を紹介したりしましたが、都度定義するのではなく、汎用的なものを定義して使う、というパターンです。

Gauche: update!

(update! place proc)という形式ですが、incfみたいなものは、

(let ((x (list 0)))
  (update! (car x) (lambda (v) (+ v 1))) 
  x)
→ (1)

と書けます。
define-modify-macroで一々定義するよりずっと良いですね。

Arc: zap

Gaucheのupdate!とほぼ同じです。引数の順番と名前が違う位です。

(let x (list 0)
  (zap (fn (v) (+ v 1))
       (car x)) 
  x)
→ (1)

TAO/ELIS: !!

以前も紹介しましたが、TAOの!!は自己代入専用の構文です。
!で印を付けた場所に書き戻せます。

(let ((x (list 0)))
  (!!(lambda (v) (+ v 1)) !(car x))
  x)
≡
(let ((x (list 0)))
  (!!1+ !(car x))
  x)

その他便利なユーティリティ

私見ではPaul Graham氏は面白い代入系ユーティリティを定義しているので、2、3眺めてみます。

Arc: pull

Common Lispのremove-ifとsetf`を組合せた感じです。

(let x '(1 100 2 50 3) 
  (pull [< _ 10] x) x)
→ ((100 50) foo) 

pushend

pushは先頭に追加なので末尾に追加したい場合に使えます

(let ((x (list 0 1 2)))
  (pushend 100 x)
  x)
→ (0 1 2 100) 

merge-into

述語で場所を探してマージします。

(let ((x (list 0 1 2 0 0 0 8 2 -1)))
  (merge-into x 5 #'<)
  x)
→ (0 1 2 0 0 0 5 8 2 -1) 

元定義は下記のような感じですが、define-modify-macroでlambda式を取れるのは処理系拡張なので、可搬的に書くならdefmacroで定義する必要があるでしょう。

しかしdefine-modify-macro版だとpushendの定義のnconcがすっぽ抜け問題が発生しそうな見た目が気持ち悪いですが、define-modify-macroの展開ではplaceに代入し直されるので大丈夫です。

;;; http://lib.store.yahoo.net/lib/paulgraham/utx.lisp

(define-modify-macro pushend (obj)
  (lambda (place obj)
    (nconc place (list obj))))
(define-modify-macro merge-into (obj fn)
  (lambda (place obj fn)
    (merge 'list place (list obj) fn)))

• 可搬的

(defmacro pushend (obj place)
  (let ((p (gensym)))
    `(let ((,p ,place))
       (setf ,p (nconc ,p (list ,obj))))))

(defmacro merge-into (place obj fn)
  (let ((p (gensym)))
    `(let ((,p ,place))
       (merge 'list ,p (list ,obj) ,fn))))

まとめ

setf系の便利構文を紹介してみました。
色々定義してみるもの面白いかなと思います。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 23目 》

先日、Common Lispのメソッドコンビネーションの実現具合とAMOPでの実現に結構な差異があると書きましたが、今回は、define-method-combinationを使わないでMOP中心でメソッドコンビネーションを定義するとどんな感じになるか、を確かめてみたいと思います。

とりあえず、Common LispとAMOP近辺のメソッドコンビネーションを実現方式を調べてみると5つ位バリエーションがみつかりました。

• ANSI Common Lisp
• Closer to MOP
• X3J13-88-003R Metaobject Protocol (Draft)
• AMOPの本文、Closetteの実装
• 各処理系の実装

まず、X3J13-88-003R Metaobject Protocolは草稿どまりですが、AMOPの流儀をベースにしつつも最適化についても考慮していたようなので複雑になっています。
また、define-method-combinationというFlavorsの流れも、MOP上に統合しようとしていたようですがこれも未完です。

次に、ANSI CL規格は、X3J13-88-003Rで練られていた事項を踏まえつつ、MOPの詳細については踏み込まない、という感じになっています。

AMOPの本文、Closetteの実装、は一つの理想形で、ANSI CL規格との兼ね合いのような瑣末なことは考慮されていません(先行しているので当然)

また、各処理系の実装は、概観するとAMOPに準拠しようとしつつ、参照実装の挙動が仕様だ、という感じになっています。
しかし参照実装とはいえ、Portable CommonLoopsの実装が仕様に準拠していない所もあり、その辺りのあやふやさは現在にも受け継がれています。

Closer to MOPは、AMOPの内容を現在メジャーなANSI Common Lisp処理系の上にポータブルな仕様と実装を実現しようとしたものです。

メソッドコンビネーションの枠組み作成

とりあえず、MOP的にメソッドコンビネーションの枠組みを作成してみましょう。

仕様は色々ありますが、compute-effective-methodがメソッドの集合を指定されたメソッドコンビネーションに応じでフォームを組み立てる、というのは共通しています。

なお、以下では、Closer to MOPを利用します。

(ql:quickload :closer-mop)

総称関数の定義

標準では、define-method-combination経由でしかメソッドコンビネーションを定義できないので、総称関数ごと別に作成します。

(defclass mcacgf (standard-generic-function)
  ()
  (:metaclass funcallable-standard-class))

メソッドコンビネーションクラスの定義

ANSI CLには、method-combinationクラスが定義されているのですが、使い方やスロットの詳細は曖昧なままです。
X3J13-88-003Rでは、サブクラスにstandard-method-combinationとstandard-simple-method-combinationを定義しているようです。
この流儀に沿っているLispWorksのような実装もある様子。

とりあえずは標準のもののサブクラスにします。

(defclass ac-method-combination (method-combination) ())

メソッドコンビネーションの配置生成定義

effective-methodというとメソッドオブジェクト(メタオブジェクト)っぽいのですが、どうも式(メタプログラム)を指しているようです。

compute-effective-methodが式を生成するので、ここで直接書き下してしまえばOKです。

下記では、単純にするために:aroundなしのstandardにしています。
(Flavorsでいうdaemon)。

define-method-combination構文の便利機能を使わず手書きしている、という感じですね。

(defmethod c2mop:compute-effective-method ((gf mcacgf)
                                           (mc method-combination)
                                           (methods list))
  (loop :for m :in methods
        :for mq := (method-qualifiers m)
        :when (equal '(:before) mq) :collect `(call-method ,m) :into bs
        :when (equal nil mq) :collect m :into ps
        :when (equal '(:after) mq) :collect `(call-method ,m) :into as
        :finally (return `(multiple-value-prog1 
                              (progn (progn :before-daemons ,@bs)
                                :primaries
                                (call-method ,(car ps) (,@(cdr ps))))
                            (progn :after-daemons ,@as)))))

メソッドコンビネーション名の登録

defgenericの:method-combinationオプションで指定できるように登録します。
しかし、find-method-combinationが実装されていない処理系もあるので、フックできないかもしれません(LispWorks等)

(defmethod c2mop:find-method-combination 
           ((gf mcacgf) (type (eql 'mcac)) opts)
  (make-instance 'ac-method-combination))
;;; LispWorksではしょうがないのでテーブルに直に登録
(setf (gethash 'mcac clos::*method-combination-types*)
      (make-instance 'ac-method-combination))

動かしてみる

(defgeneric foo (x)
  (:generic-function-class mcacgf)
  (:method-combination mcac))
(defmethod foo (x) x)
(defmethod foo :after (x) 
  (print (list :after x)))
(defmethod foo :before (x)
  (print (list :before x)))
(foo 42)
▻ (:before 42) 
▻ (:after 42) 
→ 42

• メソッドコンビネーション展開

(c2mop:compute-effective-method #'foo
                                (make-instance 'ac-method-combination)
                                (compute-applicable-methods #'foo (list t)))
→ (multiple-value-prog1
      (progn
        (progn
          :before-daemons
          (call-method #<standard-method foo (:before) (t) 40E0460B83>))
        :primaries
        (call-method #<standard-method foo nil (t) 40E042A5EB> nil))
    (progn
      :after-daemons
      (call-method #<standard-method foo (:after) (t) 40E0429F9B>)))

困った所

define-method-combinationオプションの:argumentsのサポートが鬼門なのですが、

1. まともに実装している処理系がないっぽい
2. MOPでどうするか文献がない

等で、MOPで:argumentsをサポートする場合、どういうAPI構成で書くべきなのか良く分かりません。
ANSI CL規格では、effective method中に展開されるとありますが、このあたりも処理系によって挙動がまちまちのようです。

まとめ

とりあえず、define-method-combinationを経由しないでメソッドコンビネーションを定義してみました。
define-method-combinationのマイナーな機能/オプションについてはCommon Lispの仕様が中途半端なせいか、どうやら忠実に実装できているは処理系がなさそうです。

SICL等は綺麗なCommon Lispを目指しているようなので、今後はSICLあたりも参照してみようかなと思います。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 22目 》
《 Lisp SETF Advent Calendar 2018 22日目 》

これまで、メソッドコンビネーションで19記事、setfで17記事程書いてきましたが、もう書くことがないです。

setfでメソッドコンビネーション活用について書けば、一挙両得なのでは!、と考えこのネタでひとつ考えてみたいと思います。

setfとメソッドコンビネーション

まず、setfでメソッドコンビネーションの活用が成立する為には、どう考えてもスロットのライタである必要があります。

(defclass foo ()
  ((x :initarg :x :accessor x :writer (setf x/))))
(defvar *foo* (make-instance 'foo :x 42))
(x *foo*)
→ 42 
(setf (x/ *foo*) 69)
(x *foo*)
→ 69 

クラスのスロット定義で、スロットに対して複数のアクセサ総称関数が定義可能ですが、setfが関係するのは、:accessorか、:writterオプションになります。

defclassで定義するアクセサは、デフォルトではstandardになることが規格で定まっています。

そのため、メソッドコンビネーションを指定したい場合は、defclassでアクセサは作らず、別途定義することになると思われます。

試してみましょう

(defgeneric (setf x-list) (val o)
  (:method-combination list))
(defmethod (setf x-list) list (val (o foo))
  (setf (c2mop:slot-value-using-class (class-of o) o 'x) val)
  val)
(defclass bar (foo) ())
(defmethod (setf x-list) list (val (o bar))
  (setf (c2mop:slot-value-using-class (class-of o) o 'x) val)
  val)
(defvar *bar* (make-instance 'bar :x 42))
(x *bar*)
→ 42 
(setf (x-list *bar*) 69)
→ (69 69) 
(x *bar*)
→ 69 

上記では、listメソッドコンビネーションを実行し代入の返り値をリストにして返しています。

これは、standardメソッドコンビネーション以外で、役に立ちそうな例を考えるのが難しい……。

setfに関しては、実行前後のフック(daemonメソッドコンビネーション)か、乗っ取り(around)があれば十分そうですね(即ちstandardメソッドコンビネーション)

通常は、同一の値を同一スロットに複数回書き込む挙動は求められていないということからもprogn等で有用なことはできなさそうです。

MOPで

(defclass foo ()
  ((x :initarg :x :accessor x :accessor-method-combination progn)))

のように書けるようにすることも検討してみましたが、これも微妙

一応役に立つ例も紹介

メソッドコンビネーションのカスタマイズの方向で書いてしまいましたが、standardとsetfの組み合わせであれば、値の設定前後のフックとして有用な使い方が可能です。

• 事前事後の値チェック(:before、:after)
• 副作用目的での手続の差し込み(:before、:after)
• 乗っ取りで、アクションを加えたり元動作を削除してしまったり(:around)

(defmethod (setf x/) :after (val (foo foo))
  (write-line "こんにちは"))
(setf (x/ *foo*) 42)
▻ こんにちは
→ 42
(defmethod (setf x/) :before (val (foo foo))
  (check-type val integer))
(setf (x/ *foo*) 'foo)
>>> error
(defmethod (setf x/) :around (val (foo foo))
  nil)
(setf (x/ *foo*) 'foo)
→ nil

まとめ

リーダーもを含めたアクセサ全般と、メソッドコンビネーションの組み合わせでは何か有用なことも可能かもしれませんが、setfのライタ限定となると、デフォルトのstandardが必要にして十分だった、ということがわかりました。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 21目 》

もうメソッドコンビネーションについて書くことがないので、深刻なネタ不足、準備不足と格闘しておりますが、このあたりでMOPとメソッドコンビネーションについて整理してみましょう。

Common Lispの場合

Common Lispの場合というか、MOPがあって、メソッドコンビネーションもあるというのはCommon Lisp位しか存在しないですが……。

まず、MOPはANSI Common Lisp規格外です。
MOPをサポートする処理系があっても良くて、それの場合はAMOP(The Art of the Metaobject Protocol)が拠り所になるでしょう程度の微妙な距離感になっています。

しかし実際にはANSI Common Lispの処理系の殆どが上述のAMOPの仕様を元にある程度互換性のあるMOPを組んで提供しています。
といってもAMOP自体、ANSI Common Lispの規格程かっちり規定できてはいないので、処理系ごとに差異はあり、その差異を埋めようというライブラリがCloser to MOPになります。

MOPの前置きが長くなりましたが、メソッドコンビネーションを定義するdefine-method-combinationはANSI Common Lisp規格で定義されているものでMOPのサポートを前提とはしていません。
メソッドを配置するコードを定義するのが、define-method-combinationですが、配置定義をしているだけで、定義に従ってあれこれするのは処理系依存です。

また、仮にMOPが存在することを前提に考えても、define-method-combinationにMOP的にオーバーライドできるフックポイントがあるわけでもないのでMOPという感じもあまりないかなと思います(MOPを前提としないデザインなので当たり前かもしれません)

たまに、Common LispのメソッドコンビネーションはMOPでカスタマイズする/可能、と説明している人がいますが、ちょっと違うかなと思います。
もしかすると、AMOPでメソッドコンビネーションを実現するのに、define-method-combinationは使わず、MOPの観点からapply-methodや、compute-effective-method-functionというものを定義して、これで解説してみせているのでCommon Lispもそうなっていると誤解していたりするのかもしれません。
実際の所は、メソッドコンビネーションはMOPがないFlavorsにもありますし、別個の概念と考えた方が良いでしょう。
AMOPはメソッドコンビネーションをMOPで実装してみせた例で、メソッドコンビネーションの追加等のカスタマイズはメソッドのオーバーライドで行う等、MOP的です。

Common Lispのメソッドコンビネーションの処理とMOP

Common Lisp場合のMOPとメソッドコンビネーションの兼ね合いですが、

1. define-method-combinationでメソッド配置を定義(コード生成の定義)
2. compute-effective-methodがコード生成の定義と、総称関数、メソッド、メソッドコンビネーションの各メタオブジェクトからコード(effective-method)を生成
3. effective-methodはcompute-discriminating-functionが総称関数の関数を作るのに使う

(defmethod foo (x) x)
(defmethod foo :after (x) x)
(set 'ms (compute-applicable-methods #'foo '(8)))
→ (#<standard-method foo (:after) (t) 402053A353>
    #<standard-method foo nil (t) 402052BAEB>) 
(set 'mc (c2mop:find-method-combination #'foo 'standard nil))
→ #<clos::standard-method-combination standard 41A10AAD3B> 
(c2mop:compute-effective-method #'foo mc ms)
→
(multiple-value-prog1
  (call-method #<standard-method foo nil (t) 411000E97B> nil)
  (call-method #<standard-method foo (:after) (t) 411000E773> nil)) 

となっています。

ちなみに、AMOPでは、

1. メソッドコンビネーションごとに、総称関数をサブクラス化する。補助メソッドの特定にはメソッド修飾子を利用。
2. compute-applicable-methods-using-classesがメソッドを集めてくる
3. メソッド群を起動するapply-methods(もしくは効率改善のcompute-effective-method-function)をオーバーライドして、メソッドの起動の組織化をカスタマイズ可能。補助メソッドは特定できるので任意に選別し配置可能。

となっていて、上に述べたように、よりMOP的になっています。
下記のコードはclosetteの例ですが、std-compute-effective-method-functionというコード生成のメソッドになっているもののAMOPのcompute-effective-method-functionと同様の雰囲気です。

(defun std-compute-effective-method-function (gf methods)
  (let ((primaries (remove-if-not #'primary-method-p methods))
        (around (find-if #'around-method-p methods)))
    (when (null primaries)
      (error "No primary methods for the~@
             generic function ~S." gf))
    (if around
        (let ((next-emfun
                (funcall
                   (if (eq (class-of gf) the-class-standard-gf)
                       #'std-compute-effective-method-function
                       #'compute-effective-method-function)
                   gf (remove around methods))))
          #'(lambda (args)
              (funcall (method-function around) args next-emfun)))
        (let ((next-emfun (compute-primary-emfun (cdr primaries)))
              (befores (remove-if-not #'before-method-p methods))
              (reverse-afters
                (reverse (remove-if-not #'after-method-p methods))))
          #'(lambda (args)
              (dolist (before befores)
                (funcall (method-function before) args nil))
              (multiple-value-prog1
                (funcall (method-function (car primaries)) args next-emfun)
                (dolist (after reverse-afters)
                  (funcall (method-function after) args nil))))))))

まとめ

Common Lispは、AMOPの記述を基準にするなら、結構Flavors寄りということなのかもしれません。

AMOP的にメソッドコンビネーション定義をするならば、compute-effective-methodをオーバーライドすることになるかなと思います。
ネタ切れなので、AMOP版メソッドコンビネーションを実装してみるかもしれません。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp SETF Advent Calendar 2018 20日目 》

今回は、Pythonや、Rubyにある自己代入構文をsetfで再現してみようかなと思います。

自己代入構文とは

a = a + bをa += bと書ける構文ですが、起源はCなのでしょうか。
aが二回評価されないので効率が良いなんていう話もあるようです。

setfで再現してみる

それではとりあえず、(setf (op a) b)の形式で定義してみましょう。
下記では、標準のオペレーターと名前が被るのでパッケージを別にしています。

(defpackage :self-assignment
  (:use :cl)
  (:shadow "+" "-" "/" "//" "OR" "AND"))
(in-package :self-assignment)
(defmacro define-self-assignment-setf (op fn)
  `(define-setf-expander ,op (place)
     (multiple-value-bind (dv v sv setter getter)
                          (get-setf-expansion place)
       (values dv
               v
               sv
               `(let ((,@sv (,',fn ,getter ,@sv)))
                  ,setter)
               getter))))
(define-self-assignment-setf + cl:+)
(define-self-assignment-setf - cl:-)
(define-self-assignment-setf / cl:/)
(define-self-assignment-setf // cl:floor)
(define-self-assignment-setf % cl:mod)
(define-self-assignment-setf or cl:or)
(define-self-assignment-setf and cl:and)

試してみる

(let ((a 100) (b 42))
  (setf (+ a) b) a)
→ 142 
(let ((a 100) (b 42))
  (setf (- a) b) a)
→ 58 
(let ((a 100) (b 42))
  (setf (/ a) b) a)
→ 50/21 
(let ((a 100) (b 42))
  (setf (// a) b) a)
→ 2 
(let ((a 100) (b 42))
  (setf (% a) b) a)
→ 16 
(let ((a 100) (b 42))
  (setf (or a) b) a)
→ 100 
(let ((a (list (list 100))) (b 42))
  (setf (and (caar a)) b) a)
→ ((42)) 

まとめ

Common Lispにはincf、decfがありますが、自己代入のようなものは、(setf place)で考えた場合、placeっぽくないので、define-modify-macroで定義するのがCommon Lisp流だなあ、と作ってみてから思ったりです。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 20日目 》

これまでメソッドコンビネーションの定義方法の解説や実際に定義してみたりをしていましたが、メソッドコンビネーションが実際にはどのように使われているかをQuicklispのライブラリ中から探して眺めてみましょう。

method-versions

メソッドコンビネーション: method-version-method-combination

メソッド修飾子でメソッドのバージョンを表現したというもの。
確かにメソッドのまとまりをメソッドコンビネーションの枠組みを使えばバージョンごとに起動したりの管理ができます。
なかなか面白いアイデアですね。

clweb

メソッドコンビネーション: join-strings

文字列を連結するメソッドコンビネーションのようです。
大分限定された使い方ですが、appendやnconcも標準にありますし、そんな感じの気分なのでしょう。

mcclim

メソッドコンビネーション: values-max-min

標準でmin、maxはありますが、多値で両方を返してくるというものです。

chanl

メソッドコンビネーション: select

CSPライブラリのchanlですが、プロセスの制御をメソッドコンビネーションで表現しているようです。
並列処理とメソッドコンビネーションで色々探してみたのですが、chanlで使われていたとは。
修飾子にsend、recv がありますが、結構活用している事例かもしれません。

3b-swf

メソッドコンビネーション: swf-part

swfファイル生成ライブラリですが、daemon各々を:most-specific-lastで起動するもののようです。

serapeum / arnesi

standard/context / wrapping-standard

もとネタは、Tim Bradshaw氏のwrapping-standardメソッドコンビネーションのようです。
standardメソッドコンビネーションの周囲を:wrap-aroundでさらに囲みます(serapeumでは:context)
:wrap-aroundはデフォルトでは、:aroundと逆順の:most-specific-lastです。

filtered-functions

filtered-functionsをメソッドコンビネーション活用の方向から眺めてみましたが、どちらかというと、メソッドコンビネーションより前の段階に工夫がある感じでした。
filtered-functionsについては過去に紹介記事がありますので、そちらをどうぞ。

• #:g1: MOPでディスパッチの多様化: filtered-functions
• #:g1: Filtered Functions面白そう

method-combination-utilities

primary / lax / basic / append/nconc

メソッドコンビネーション定義のためのユーティリティと、有用そうなメソッドコンビネーション定義のライブラリです。

すっかり忘れていましたが、過去に紹介記事も書いていました。

• #:g1: method-combination-utilitiesの紹介

このブログでもmc-expandのようなものを定義していましたが、method-combination-expandみたいなものも定義されています。
メソッドコンビネーションを活用するなら試してみて損はなさそうなユーティリティです。
しかし、LispWorksで動かない様子(PR出そうかな)

まとめ

案外使う人はカジュアルに使っている様子。
メソッドコンビネーションを学んで活用しましょう!

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 19日目 》

メソッドコンビネーションでD風の契約プログラミング: その1の続きですが、前回は、不変条件をメソッドコンビネーションでどう組むかというところまででした。

Dでは、不変条件は、クラス内でinvariantで定義され、

• すべてのコンストラクタの末尾
• デストラクタの冒頭
• メソッドの冒頭と末尾

に設置されるらしいです。
総称関数でこれをどう表現するかというところですが、

• すべてのコンストラクタの末尾 ⇒ スロットアクセスチェックを:afterで起動?
• デストラクタの冒頭 ⇒ clange-classで起動?
• メソッドの冒頭と末尾 ⇒ 総称関数なのでスロットアクセスチェックで良いでしょう

位になるでしょうか。

定義してみる

とりあえず、こんなdateクラスがあったとして、

(defclass date () 
  ((year :initarg :year :accessor year)
   (month :initarg :month :accessor month)
   (day  :initarg :day :accessor day))
  (:default-initargs :year 1900 :month 1 :day 1))
(make-instance 'date)
→ #<date 402026FA73> 

invariantメソッドが差し込んで使うようなメソッドコンビネーションを定義します。
andと同じような感じですが、基底クラスから順に適用してandの関係になるようにするので、継承順をreverseし、同じクラスに複数のメソッドを付けたいので、修飾子をワイルドカードにしました。

(define-method-combination invariant ()
  ((pri *))
  `(and ,@(loop :for m :in (reverse pri) :collect `(call-method ,m))))

これで、dateのスロットについてinvariantメソッドで不変条件を記述します。

(defmethod invariant year ((date date))
  (etypecase (year date)
    (integer T)))
(defmethod invariant month ((date date))
  (etypecase (month date)
    ((integer 1 12) T)))
(defmethod invariant day ((date date))
  (etypecase (day date)
    ((eql 29) (or (/= 2 (month date))
                  (leap-year-p (year date))))
    ((eql 30) (/= 2 (month date)))
    ((eql 31) (typep (month date) '(member 1 3 5 7 8 10 12)))))

このinvariantをスロットに取り付けます。

(defmethod c2mop:slot-value-using-class ((date-class standard-class)
                                         (date date)
                                         slot)
  (invariant date)
  (multiple-value-prog1
    (call-next-method)
    (invariant date)))

(defmethod (setf c2mop:slot-value-using-class) 
           (value (date-class standard-class) (date date) slot)
  (invariant date)
  (multiple-value-prog1
    (call-next-method)
    (invariant date)))

これだけでいけるかなと思ったのですが、

(make-instance 'date :year 100 :month 2 :day -2)
→ #<date 4020118C13> 

あれ……?

インスタンス生成もチェックする

インスタンス生成はslot-value-using-classはスルーする(かもしれない)ようなので、clange-classのことも考えて、shared-initializeにinvariantを設置しました(もうちょっと細かく設定した方が良いかもしれません)

(defmethod shared-initialize :after ((date date) slots &key)
  (invariant date))

これで生成系はエラーにできます。

(make-instance 'date :year 100 :month 2 :day -2)
>>> error
(defclass date2 () 
  ((year :initform 1900 :initarg :year :accessor year)
   (month :initform 1 :initarg :month :accessor month)
   (day :initform 1 :initarg :day :accessor day)))
(change-class (make-instance 'date2 :year 100 :month 2 :day -2)
              'date)
>>> error

invariantメソッドコンビネーションの展開はこんな感じになります

(defclass datetime (date) 
  ((hour :initarg :hour :accessor hour)
   (minute :initarg :minute :accessor minute)
   (second  :initarg :second :accessor sec))
  (:default-initargs :hour 0 :minute 0 :second 0))
(defmethod invariant hour ((dt datetime))
  (etypecase (hour dt)
    ((integer 0 24) T)))
(defmethod invariant minute ((dt datetime))
  (etypecase (minute dt)
    ((integer 0 59) T)))
(defmethod invariant second ((dt datetime))
  (etypecase (sec dt)
    ((integer 0 59) T)))
(mc-expand #'invariant
           'invariant
           nil
           (make-instance 'datetime))
→
(and (call-method #<standard-method invariant (year) (date) 41602356B3>)
     (call-method #<standard-method invariant (month) (date) 40D035A8B3>)
     (call-method #<standard-method invariant (day) (date) 40D035A113>)
     (call-method #<standard-method invariant (hour) (datetime) 40D04205BB>)
     (call-method #<standard-method invariant (minute) (datetime) 402025F913>)
     (call-method #<standard-method invariant (second) (datetime) 402027434B>)) 

これらinvariantを付加する作業をどうにかまとめたいのですが、MOPを使うかマクロて手続きを纏めるか悩む所です。 invariant手続きをdefclassで指定した方が良さそうなので、MOPになりそうです。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp SETF Advent Calendar 2018 19日目 》

今回は、たまに便利な(setf apply)/(setf values)を解説してみたいと思います。

(setf values) | VALUES Forms as Places

(setf values)はそこそこ使われているかと思いますが、Common Lisp(1984)の時代から知識の更新がない年配の方々がmultiple-value-setqしか知らないような場面に遭遇することもままあります。
(古い書籍で勉強してしまったので知らなかった、ということもあります)

• 5.1.2.3 VALUES Forms as Places

multiple-value-setq的な使い方

(let (q r)
  (setf (values q r) (floor 1 2))
  (list q r))
→ (0 1) 

psetq、psetf的な使い方

(let ((a 0) (b 1))
  (setf (values a b) (values b a))
  (list a b))
→ (1 0) 

(setf values)は他のsetfの場所と複合できるのも便利です

(let ((x (list 0 1)))
  (setf (values (car x) (cadr x))
        (values (cadr x) (car x)))
  x)
→ (1 0) 

(setf apply) | APPLY Forms as Places

こちらは、Common Lisp(1984)からありますが、配列を多用する人以外は使う機会もないからか、それほど知られていない機能です。

• 5.1.2.5 APPLY Forms as Places

添字のリストだけあって、それを適用したい、ということはあるのですが、(setf apply)とarefを組合せれば可能です。

(let ((subs (list 2 1 0)))
  (setf (apply #'aref *a* subs) 42)
  *a*)
→
#3A(((0 0 0) (0 0 0) (0 0 0))
    ((0 0 0) (0 0 0) (0 0 0))
    ((0 0 0) (42 0 0) (0 0 0))) 

規格では、aref、bit、sbitと(setf apply)の組合せは保証されていますが、他は、処理系依存です。
というのも、(setf fn)は必ずしも関数である必要はないためで、マクロで実装されている場合、applyできない、ということになるからです。

ユーザー定義の#'(setf fn)関数であれば、applyが適用できるので(setf apply)も可能です。

まとめ

(setf values)はもっと知られても良いかなと思っています。
ANSI Common Lispと、それ以前のCLtL2、CLtL1は結構違ってますので、仕様の参照/勉強では、ANSI Common Lisp規格を元にした文献を参照しましょう。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 18日目 》

メソッドコンビネーションでD風の契約プログラミングの続きを書こうと思いましたが、準備が間に合わないので、思い付きでマクロでもメソッドコンビネーションというネタを書きます。

ANSI Common LispにはAdviceはありませんが、処理系拡張でdefadviceのようなものでadviceを定義することが可能だったりします。
adviceは関数だけでなく、マクロやメソッドにも付けられたりしますが、LispWorksでマクロのadvice定義を利用した例は、こんな感じです。

(defmacro mydefun (name (&rest args) &body body)
  `(defun ,name (,@args) ,@body))

(defadvice (mydefun inline :around) (form env)
  (destructuring-bind (def name args &body body)
                      form
    (declare (ignore def args body))
    `(progn
       (declaim (inline ,name))
       ,(call-next-advice form env))))

(mydefun foo (n) n)
;===> (PROGN (DECLAIM (INLINE FOO)) (DEFUN FOO (N) N))

標準では、マクロの展開関数は関数なので拡張できないのですが、メソッドにして、好きなメソッドコンビネーションを指定してしまえば良い!ということで、マクロ展開メソッドでメソッドコンビネーションです。

雑ですが、こんな感じに書いてみました。

(defmacro defmacro* (name-&-method-qualifiers (&rest args) &body body)
  (destructuring-bind (name &rest method-qualifiers)
                      (if (consp name-&-method-qualifiers) 
                          name-&-method-qualifiers
                          (list name-&-method-qualifiers))
    (let ((form (gensym "form-"))
          (env (gensym "env-"))
          (xn (or (get name :expander)
                  (setf (get name :expander) 
                        (make-symbol (string name))))))
      `(eval-when (:compile-toplevel :load-toplevel :execute)
         (defmethod ,xn ,@method-qualifiers (,form ,env)
           (macrolet ((call-next-expander (&rest args)
                        `(call-next-method ,@args)))
             (destructuring-bind (,name ,@args)
                                 ,form
               (declare (ignore ,name))
               ,@body)))
         (setf (macro-function ',name)
               #',xn)))))

deという名前でdefunのエイリアス的なものを定義してみる

(defmacro* de (name (&rest args) &body body)
  `(defun ,name (,@args) ,@body))
(de foo (n) (list n n))
===> 
(defun foo (n) (list n n))

de周囲をeval-whenで囲みたくなった

(defmacro* (de :around) (name (&rest args) &body body)
  `(eval-when (:compile-toplevel :load-toplevel :execute)
     ,(call-next-expander)))

(de foo (n) (list n n))
===>
(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun foo (n) (list n n)))

deの定義は全部無効にしたくなった

(defmacro* (de :around) (name (&rest args) &body body)
  nil)
(de foo (n) (list n n))
===> nil

雑なのでメソッドの良さを全然活かせてないですが、使いようによっては便利なこともあるかも、と少しだけ思いました。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp SETF Advent Calendar 2018 18日目 》

今回は、処理系拡張のsetfのうち解構destructuring系の拡張を眺めてみたいと思います。

destructuringの邦訳語はいまいち一定しない感がありますが、中華圏では、ほぼ、解構destructuringで通っているようです。

• 例: 解構賦值 | MDN

解構destructuringは短くて意味の通りも良い気がするので、本記事では、解構destructuringで通します。
(しかし流行らなそうな言葉の響き……)

解構destructuring拡張のsetfとは

setfの場所placeで解構destructuringを使うという拡張です。
Lisp Machine Lispには標準装備だったみたいですが、Common Lispで実装している処理系はないかもしれません。
ということで、以下は、Lisp Machine Lispでの例の紹介です。
(Common Lispでも定義はできます)

(setf list)

これまで、左辺値についてCPLを調べたりもしましたが、CPLは左辺にリスト構文が取れたりしました。

x, y, z := 0, 1, 2

これをそのままsetfで書いた感じです。

(let (x y z)
  (setf (list x y z) '(0 1 2))
  (list x y z))
→ (0 1 2)

(setf cons) / (setf list*)

cons、list*も使えます。

(let (x y)
  (setf (cons x y) '(0 1 2))
  (list x y))
→ (0 (1 2))
(let (x y z)
  (setf (list* x y z) '(0 1 2))
  (list x y))
→ (0 1 (2))

(setf `(,foo ,@bar))

バッククォート式も使えます。
但し、appendの形には対応していないので、,@はリストの最後の部分にしか使えません。

(let (x y)
  (setf `(,x ,@y) '(0 1 2))
  (list x y))
→ (0 (1 2))
(let (x y z)
  (setf `(,x ,y ,@z) '(0 1 2))
  (list x y))
→ (0 1 (2))

appendの形には対応していないものの、入れ子にすることは可能です。

(let (a b c d e f)
  (setf `(,a (,b (,c ,@d) ,e ,@f))
        `(a (b (c d d d) e f f f)))
  (list a b c d e f))
→ (a (b (c (d d d) e (f f f))))

list、list*、consも同様

(let (a b c d e f)
  (setf (list (list* (cons c d) e f))
        `(a (b (c d d d) e f f f)))
  (list a b c d e f))
→ (a (b (c (d d d) e (f f f))))

まとめ

setfとバッククォートの組み合わせはなかなか良いんじゃないかと思うのですが、実際の所、あってもそんなに利用頻度は高くなさそうですね。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 17日目 》

契約プログラミングをメソッドコンビネーションを表現するネタは既にあるのですが、

• #:g1: MOPで契約プログラミング 参照

もうちょっと簡潔に書けそうな気がしてきたので、試しにD風の契約プログラミングの仕組みを書いてみることにしました。

Dには契約プログラミングが組み込み機能ですが、in節で事前条件のチェック、body節は本体、out節で事後条件をチェックするようになっています。

継承がからんだ場合は、事前条件は、基底クラスから条件をorのでチェック、事後条件は、基底クラスからandでチェック、のようです。

out節で返り値を受け取ってチェックするというのをどう表現するのか厄介ですが、outはチェック関数を返して、プライマリの返り値をチェックすることにしました。

(define-method-combination ddbc ()
  ((in* (:in))
   (out* (:out))
   (pri* () :required T))
  (let ((results (gensym "results-")))
    `(progn
       (or ,@(loop :for in :in (reverse in*) :collect `(call-method ,in))
           (error "in"))
       (let ((,results (multiple-value-list (call-method ,(car pri*) ,(cdr pri*)))))
         (declare (dynamic-extent ,results))
         (or (and ,@(loop :for out :in (reverse out*) :collect `(apply (call-method ,out) ,results)))
             (error "out"))
         (values-list ,results)))))

これでこんな風に書くと、

(defgeneric integer->integer->integer (x y)
  (:method-combination ddbc))
(defmethod integer->integer->integer :in ((x number) (y number))
  (and (integerp x)
       (integerp y)
       (not (zerop y))))
(defmethod integer->integer->integer ((x number) (y number))
  (/ x y))
(defmethod integer->integer->integer :out ((x integer) (y integer))
  #'integerp)

こんなメソッドコンビネーション展開になります

(mc-expand #'integer->integer->integer 'ddbc nil 1 2)
→
(progn
  (or (call-method
       #<standard-method integer->integer->integer (:in) (number
                                                          number) 414009E67B>)
      (error "in"))
  (let ((#:|results-166692|
         (multiple-value-list (call-method
                               #<standard-method integer->integer->integer nil (number
                                                                                number) 414009E45B>
                               nil))))
    (declare (dynamic-extent #:|results-166692|))
    (or (and (apply (call-method
                     #<standard-method integer->integer->integer (:out) (integer
                                                                         integer) 40202D35A3>)
                    #:|results-166692|))
        (error "out"))
    (values-list #:|results-166692|)))

実行してみます

(defmacro run (form)
  "結果確認用ユーティリティ"
  `(multiple-value-bind (ans error)
                        (ignore-errors ,form)
     `(,',form :result ,ans :error 
               ,(and error
                     (format nil 
                             (simple-condition-format-control error)
                             nil
                             (simple-condition-format-arguments error))))))
(list 
 (run (integer->integer->integer 1 8))
 (run (integer->integer->integer 1 0))
 (run (integer->integer->integer 10 2))
 (run (integer->integer->integer 10 1/2)))
→
(((integer->integer->integer 1 8) :result nil :error "out")
 ((integer->integer->integer 1 0) :result nil :error "in")
 ((integer->integer->integer 10 2) :result 5 :error nil)
 ((integer->integer->integer 10 1/2) :result nil :error "in"))

まあまあ、動いているようです。

不変条件は、クラスのスロット側にメソッドコンビネーションを付けることになりそうですが、間に合ってないので次回にします。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp SETF Advent Calendar 2018 17日目 》

今回は、処理系拡張のsetfのうち制御構造の拡張を眺めてみたいと思います。

処理系拡張のsetfとは

Common Lispの処理系には、setfの拡張が許されていますが、殆ど拡張は入れてない処理系から突飛なものを入れている処理系まで様々です。

CLISPに結構拡張が入っているので、今回はCLISPを中心に眺めてみます。

(setf if)

setfでifが使えるのですが、そこそこ便利かもしれません。
ifを使ったマクロ展開がされてもsetfの場所として有効なので、言語コアでsetf展開が可能だと、かなり拡張されることになります。

(let ((x 0)
      (y 1))
  (incf (if (< x y) x y))
  (list x y))
→ (1 1)

• orはifに展開されるので、直接定義されていなくても(setf or)が使える

(let ((x nil)
      (y 1))
  (incf (or x y))
  (list x y))

展開はこんな感じです

(let* ((#:cond-29533 (< x y)) (#:new-29534 (+ (if #:cond-29533 x y) 1)))
  (if #:cond-29533
      (setq x #:new-29534)
      (setq y #:new-29534)))

(setf progn)

prognも言語のコアなので、これもsetf化の底上げになります。

(let ((x 0)
      (y 0)
      (z 0))
  (incf (progn x y z))
  (list x y z))
→ (0 0 1)

(setf locally)

locallyも言語のコアなので、マクロ展開の結果への適用を考えているのだと思いますが、theの代わりに使える気もします。

(let ((x 0)
      (y 1)
      (z 2))
  (setf (locally (declare (fixnum x y z ))
          (values x y z))
        (values 1 1 1))
  (list x y z))
→ (1 1 1)

(setf funcall)

規格では、(setf apply)が使えるので、ちょっとした変種というところです。

(let ((u (list 0 1 2)))
  (incf (funcall #'cadr u))
  u)
→ (0 2 2)

(setf let)

ここからはLisp Machine Lispに実装されていたものですが、locative(参照)が扱えるので、かなり妙なことが可能です。

(let ((x 0)
      f)
  (setf (let ((x x))
          (setq f (lambda () x))
          x)
        42)
  (list x (funcall f)))
→ (0 42)

上記の(setf let)内のxは外側のxをシャドウしていますが、末尾でx変数を返しているので、その参照に42を代入しています。
スコープの外から代入できてる感じなのがエグいですが、ここまで極端な使い方は想定していなそうではあります。

(setf setq)

これはLisp Machine Lispでも有効になっていませんが、コードの断片があるので有効にしてみると、

(let ((x 0)
      (y (list 0 1 2)))
  (setf (setq x (car y)) 42)
  (list x y))
→ (42 (42 1 2))

こんなことを考えていたようです。
setqの場合は、値の方の参照に代入します。なかなかエグい。

まとめ

役に立ちそうなものから、面白機能なものまで紹介してみました。
次回は、リスト操作系の拡張を紹介してみたいと思います。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 16日目 》

メソッドコンビネーションは、メソッドの集合をあるコンビネーションで実行することなので並列実行も範疇に入ると思われます。

メソッドコンビネーションで並列実行の例は、そこそこあるだろうと思ってネットをしばらく検索してみましたが、どうやらあまり試してみた例はないようです。

NetCLOSの構文の見た目が、メソッドコンビネーションっぽかったのでソースを確認してみましたが、残念ながら、並列実行のパターンに直接メソッドコンビネーションを活用している訳ではない様子(メッセージ送信のシークエンスに活用してはいるようです)
ちなみに、NetCLOSは、ABCL/1にインスパイアされたアクターベースの並列オブジェクト指向なCLOSのネットワーク拡張です。

• NetCLOS – Common Lisp Object System for the Net:

メソッドコンビネーションと素朴な並列実行

非常に素朴ですが、各メソッドをスレッドに分配して全部実行してジョインというのは簡単に書けます。
コンビネーションとしては、prognメソッドコンビネーションが並列に実行される、という感じでしょうか。

(define-method-combination par ()
  ((ms (:name . *)))
  (let ((ths (loop :for () :in ms 
                   :collect (gensym "thread-"))))
    `(let (,@(mapcar (lambda (m th)
                       `(,th (bt:make-thread 
                              (lambda ()
                                (call-method ,m))
                              :name ,(second (method-qualifiers m)))))
                     ms
                     ths))
       (let ((ans (list ,@ths)))
         (declare (dynamic-extent ans))
         (values-list (mapcar #'bt:join-thread ans))))))

(defgeneric para (x &optional out)
  (:method-combination par))
(defmethod para :name "foo" (x &optional out)
  (format out "~&start A ...~%")
  (sleep 3)
  (format out "~&... end A~%"))
(defmethod para :name "bar" (x &optional out)
  (format out "~&start B ...~%")
  (sleep 5)
  (format out "~&... end B~%"))

• メソッドコンビネーションの展開

(mc-expand #'para 'par nil 3)
→ 
(let ((#:|thread-181190|
       (bt:make-thread (lambda ()
                         (call-method #<standard-method para (:name "bar") (t) 40303B7D63>))
                       :name "bar"))
      (#:|thread-181191|
       (bt:make-thread (lambda ()
                         (call-method #<standard-method para (:name "foo") (t) 40303A6263>))
                       :name "foo")))
  (let ((ans (list #:|thread-181190| #:|thread-181191|)))
    (declare (dynamic-extent ans))
    (values-list (mapcar #'bt:join-thread ans))))

• 実行してみる

(para 3 #.*standard-output*)
start A ...
start B ...
... end A
... end B
→ nil
   nil

上記では、ジョインする手間が省けている程度ですが、やりようによっては役に立つものができるかもしれません……。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp SETF Advent Calendar 2018 16日目 》

今回は、ローカルスコープでのsetf定義について考えてみます(ネタがないから)

ローカルスコープでsetfとは

ANSI Common Lispでは、(setf fn)という関数名が使えるということは以前解説したのですが、これはflet/labelsでも勿論使えます。
つまり、ローカルスコープ限定でsetfフォームが書けるということになります。

• CLHS: 5.1.2.9 Other Compound Forms as Places

#'(setf fn)

(let ((u (list 0 1 2 3 4)))
  (flet (((setf kar) (val cons)
           (rplaca cons val)))
    (setf (kar u) 42)
    u))
→ (42 1 2 3 4) 

Macro Forms as Placesのローカル版

macroletはローカルスコープのマクロを作りますが、Macro Forms as Placesもまたローカルで成立することになります。

(let ((u (list 0 1 2 3 4)))
  (macrolet ((kar (list)
               `(car ,list)))
    (setf (kar u) 42)
    u))
→ (42 1 2 3 4) 

defsetfやdefine-setf-expanderで定義するもののローカル版

setfletや、setf-expander-bindのような、そのボディ内でsetfフォームが書けるような構文を定義しない限り、無理ではないかなと思います。
特にdefine-setf-expanderの方はmacroletにちょっと細工する位では実現が無理に思えるので、コードウォーカーを駆使する他なさそうです。

まとめ

まあ、ローカルのsetfは、ほぼ使うこともないのですが、setfletや、setf-expander-bindのようなものを作ってみるのは、上級マクロ学習の良い題材になりそうな気はします。
興味のある方は試してみては如何でしょうか。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp SETF Advent Calendar 2018 15日目 》

setf系構文の紹介ですが、今回は、defstruct、defclassでおまけに定義できるsetfの紹介です。

defstructとsetf

MACLISP系Lispではsetfとdefstructは誕生から共に歩んできた感じですが、defstructの便利機能の一つに、アクセサを自動生成してくれる、というのがあります。

(defstruct zot x y z)
(let ((z (make-zot)))
  (setf (zot-x z) 42)
  z)
→ #S(zot :x 42 :y nil :z nil) 

デフォルトで(setf zot-x)という名前で作成してくれますが、この名前が気に入らない場合は、調整することも可能です。

(defstruct (zot (:conc-name ""))
  x y z)
(let ((z (make-zot)))
  (setf (x z) 42)
  z)
→ #S(zot :x 42 :y nil :z nil) 

しかし、定義しない、という選択はできないので、ごく稀に名前の競合などで面倒なことがあったりはします。

defclassとsetf

後発のdefclassでは、defstructのように決め打ち動作は抑えられるため名前の競合問題は制御可能です。

スロットの指定で、:accessorを指定すれば、リーダーメソッドと(setf 名前)というセッターメソッドが定義されます。

:writerでは、シンボルと(setf fn)形式が指定可能で、スロットに複数指定可能なので複数の名前が一度に定義できます。

(defclass kiji ()
  ((x :accessor kiji-x)
   (y :accessor kiji-y)
   (z :accessor kiji-z :writer set-kiji-z :writer (setf hyper-kiji-z))))
(let ((o (make-instance 'kiji)))
  (setf (kiji-x o) 42)
  (kiji-x o))
→ 42 
(let ((o (make-instance 'kiji)))
  (setf (hyper-kiji-z o) 43)
  (kiji-z o))
→ 43 
(let ((o (make-instance 'kiji)))
  (set-kiji-z 43 o)
  (kiji-z o))
→ 43 

ちなみに、アクセサの名前ごとに別の総称関数なので個々のメソッドコンビネーションを付与できます(コンビネーションはstandardのみ可能)

(defmethod (setf hyper-kiji-z) :before (val (obj kiji))
  (print 'hyper-kiji-z))
(let ((o (make-instance 'kiji)))
  (setf (kiji-z o) 43)
  (kiji-z o))
→ 43 
(let ((o (make-instance 'kiji)))
  (setf (hyper-kiji-z o) 43)
  (kiji-z o))
▻ hyper-kiji-z
→ 43 

まとめ

改めて確認してみるとdefclassが随分多機能だなと感心します。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 15日目 》

前回、メソッドコンビネーション元祖のFlavorsのdefwrapperの定義と:aroundの比較をしてみましたが、今回は、New Flavorsで登場したwhopperも加えてCommon Lispで再現してみようと思います。

FlavorsとNew Flavorsの違いですが、New FlavorsはSymbolicsがFlavorsを改良したもので、sendでのメッセージパッシング構文から、総称関数ベースに変更になった所が目立った違いです。
といっても、send構文もオブジェクトをfuncallしていたので、ちょっとした発想の転換程度の変化にみえます。
なお、New Flavorsは総称関数、多重継承ですが、マルチメソッドではありません。

Flavorsは、MITで開発され、MACLISP系のLisp(Lisp Machine Lisp、MACLISP、Franz Lisp、Zetalisp、Common Lisp)に実装されましたが、方言を跨ぐオブジェクトシステムというもの良く考えると面白いです。

wrapper/whopperの違い

さて、とりあえず、wrapper、whopperの解説ですが、wrapperはこれまでの記事で解説したように、メソッドの周囲を包むマクロ群です。
whopperは、New Flavorsから登場したようですが、Symbolics Common Lisp(1986)のマニュアルを眺めるとCommon Lispの:aroundと挙動は全く同じようです。バーガーキングのワッパーと何か関係があるのでしょうか。
それはさておき、マニュアルでは、マクロのwhopperは再コンパイルが必要だったりして扱いが若干面倒なので極力関数のwhopperを使おうとあります。

wrapperもwhopperも同一の機能ですが、混ぜて使った場合の説明もあり、その場合はwrapperが最外周を取るようです。
wrapperは、マクロなのでほんのちょっと速くできるとありますが、whopperにもインライン展開の構文もあったりするので本当にそうだったのかは謎です。

wrapper/whopperを再現してみる

defwhopper

Common Lispはマルチメソッドなので、シングルメソッドのFlavorsとは若干引数のインターフェイスを変える必要がありますが、大体こんな感じにしました。

(defmacro defwhopper (name (&rest args) &body body)
  `(defmethod ,name :whopper (,@args)
     (flet ((continue-whopper (&rest args)
              (apply #'call-next-method args))
            (lexper-continue-whopper (&rest args)
              (apply #'apply #'call-next-method args)))
       ,@body)))

defwrapper

wrapperの方は、ボディにマクロ展開を記述するのですが、展開関数をメソッドとは別に管理すると面倒なので、式を展開するメソッドを:wrapperメソッドとして記録することにしてみました。

メソッドコンビネーションの展開時に、:wrapper修飾子のメソッドを集めて、残りのフォームを引数に展開していく方針です。

(defmacro defwrapper (name (margs &body mbody) &body body)
  (let ((form (gensym "form-")))
    `(defmethod ,name :wrapper (,@margs)
       (lambda (,form env)
         (declare (ignore env))
         (destructuring-bind ,mbody ,form
           ,@body)))))

メソッドコンビネーション定義

wrapperは最外周なのとマクロ展開させるので若干特殊な動きをしますが、standardメソッドコンビネーションの:aroundを:whopperに置き換えたものをwrapperで包んでいく感じで大丈夫でしょう。

;;; Symbolics風のユーティリティ
(defmacro multiple-value-prog2 (form1 form2 &body body)
  `(progn
     ,form1
     (multiple-value-prog1 ,form2 ,@body)))
(define-method-combination :wrapper ()
  ((whopper (:whopper))
   (before (:before))
   (primary () :required t)
   (after (:after))
   (wrapper (:wrapper)))
  (flet ((call-methods (methods)
           (mapcar #'(lambda (method)
                       `(call-method ,method))
                   methods)))
    (let* ((form (if (or before after (rest primary))
                     `(multiple-value-prog2
                        (progn ,@(call-methods before))
                        (call-method ,(first primary)
                                     ,(rest primary))
                        ,@(call-methods (reverse after)))
                     `(call-method ,(first primary))))
           (whopper (if whopper
                        `(call-method ,(first whopper)
                                      (,@(rest whopper)
                                       (make-method ,form)))
                        form)))
      (if wrapper
          (reduce (lambda (w ans)
                    (let ((expander (funcall (method-function w) nil nil)))
                      (funcall expander (list ans) nil)))
                  wrapper
                  :initial-value whopper
                  :from-end T)
          whopper))))

使ってみる

まずは、プライマリを定義してみます

(defgeneric foo (x)
  (:method-combination :wrapper))
(defmethod foo (x) x)
(foo "42")
→ "42" 

次にwrapperを定義。
stringはプライマリがありませんが、wrapperは動きます。

(defwrapper foo ((x) &body body)
  `(multiple-value-prog2 
     (format T "~A~%" '(foo t :wrapper :in))
     ,@body
     (format T "~A~%" '(foo t :wrapper :out))))
(defwrapper foo (((x string)) &body body)
  `(multiple-value-prog2 
     (format T "~A~%" '(foo string :wrapper :in))
     ,@body
     (format T "~A~%" '(foo string :wrapper :out))))
(foo "42")
▻ (foo string wrapper in)
▻ (foo t wrapper in)
▻ (foo t wrapper out)
▻ (foo string wrapper out)
→ "42" 

次にstringのプライマリを定義して実行してみます

(defmethod foo ((x string))
  (values (read-from-string x)))
(foo "42")
▻ (foo string wrapper in)
▻ (foo t wrapper in)
▻ (foo t wrapper out)
▻ (foo string wrapper out)
→ 42

次に、whopperを定義してみます。

(defwhopper foo ((x string))
  (let ((*read-base* 5.))
    (continue-whopper x)))
(foo "42")
▻ (foo string wrapper in)
▻ (foo t wrapper in)
▻ (foo t wrapper out)
▻ (foo string wrapper out)
→ 22

メソッドコンビネーションの展開はこんな感じです。
wrapperはcall-methodの連鎖にならずにベタ書きになっているのがわかります。

(mc-expand #'foo
           :wrapper
           nil
           "42")
→
(multiple-value-prog2
  (format t "~A~%" '(foo string :wrapper :in))
  (multiple-value-prog2
    (format t "~A~%" '(foo t :wrapper :in))
    (call-method
     #<standard-method foo (:whopper) (string) 40E01F98B3>
     ((make-method
       (multiple-value-prog2 (progn)
         (call-method
          #<standard-method foo nil (string) 40E01C1253>
          (#<standard-method foo nil (t) 40E00E75EB>))))))
    (format t "~A~%" '(foo t :wrapper :out)))
  (format t "~A~%" '(foo string :wrapper :out)))

まとめ

New Flavorsのwrapper/whopperを再現してみましたが、マクロだったwrapperが使い易く関数のwhopperとしてまとめられ、そこからCommon Lispの:aroundへ統合されたらしいことがわかります。

define-method-combinationのインターフェイスは、New Flavors時代に固まったようですが、どうもwrapperの仕組みが念頭にあった設計に思えてしまいます。
MOP前提なら、もうちょっと違ったインターフェイスにできる気がするのですが、残念ながらANSI Common Lispでは、MOPが規格外になってしまったので、MOP前提ではないdefine-method-combinationのインターフェイスも生き残ったという所なのかもしれません。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 14日目 》

Flavorsには、Common Lispのメソッドコンビネーションの:aroundが無いようなのですが、その代わりにdefwrapperという構文があったようです。

defwrapperの発展的解消の結果、:aroundに纏められたのかなと思えてきたのですが、CADRのエミュレータ上でdefwrapperの実際の使い勝手と挙動を確認してみることにしました。

挙動確認のお題ですが、先日のstandardメソッドコンビネーションの説明で:before、:after、primary、:around全部盛りの定義を紹介したものをFlavorsに書き換えて試してみます。

• 定番メソッドコンビネーション紹介: standard

Flavorsは、(CADR System 78.48 (1982年あたり))のものです。

(progn
  (defflavor f1 () ())
  (defflavor f2 () (f1))
  (defflavor f3 () (f2)))
(progn
  (defmethod (f1 foo) ()
    (format T "~16T~A~%" '(foo f1)))
  (defmethod (f2 foo) ()
    (format T "~16T~A~%" '(foo f2))
    (funcall #'(:method f1 foo) self))
  (defmethod (f3 foo) ()
    (format T "~16T~A~%" '(foo f3))
    (funcall #'(:method f2 foo) self))
  ;;
  (defmethod (f1 :before foo) ()
    (format T "~8T~A~%" '(foo f1 :before)))
  (defmethod (f2 :before foo) ()
    (format T "~8T~A~%" '(foo f2 :before)))
  (defmethod (f3 :before foo) ()
    (format T "~8T~A~%" '(foo f3 :before)))
  ;;
  (defmethod (f1 :after foo) ()
    (format T "~24T~A~%" '(foo f1 :after)))
  (defmethod (f2 :after foo) ()
    (format T "~24T~A~%" '(foo f2 :after)))
  (defmethod (f3 :after foo) ()
    (format T "~24T~A~%" '(foo f3 :after))))
(progn
  (defwrapper (f3 foo) (() . body)
    `(progn 
       (format T "~A~%" '(foo f3 :wrapper))
       . ,body))
  (defwrapper (f2 foo) (() . body)
    `(progn 
       (format T "~A~%" '(foo f2 :wrapper))
       . ,body))
  (defwrapper (f1 foo) (() . body)
    `(progn 
       (format T "~A~%" '(foo f1 :wrapper))
       . ,body)))

(<- (make-instance 'f3) 'foo)
▻ (FOO F3 WRAPPER)
▻ (FOO F2 WRAPPER)
▻ (FOO F1 WRAPPER)
▻         (FOO F3 BEFORE)
▻         (FOO F2 BEFORE)
▻         (FOO F1 BEFORE)
▻                 (FOO F3)
▻                 (FOO F2)
▻                 (FOO F1)
▻                         (FOO F1 AFTER)
▻                         (FOO F2 AFTER)
▻                         (FOO F3 AFTER)
→ NIL

思えば、Flavorsには、call-next-methodのようなものがない気がするのですが、とりあえず、Common Lispと違ってfunctionの記法が拡張されているので、(funcall #'(:method f2 foo) self) という風にメソッドを直接起動してしのいでいます。

後期のFlavorsや、New Flavorsにはあるのかもしれません。
そもそもFlavorsは標準規格化されてないので、実装によりAPIや挙動がまちまちなので確認が、ちょっとしんどいです。

上記のコードをみて分かるかと思いますが、:aroundの中で、call-next-methodを呼ぶのではなく、defwrapperでは、メソッドのコードをマクロで包み込む、という感じになります。

また、defwrapperはマクロではありますが、Flavorを指定できるので、どのメソッドの外周を包むかを:aroundと同じく指定することが可能です。

まとめ

defwrapperが:aroundに置き換わったと考えると、Common Lispのメソッドコンビネーションの動作の謎が解ける気がして、Flavorsのdefwrapperを紹介してみました。

後期Flavors、New Flavors、さらに、defwrapper以外の謎構文、defwhopperとメソッドコンビネーションについても調べて纏めてみたいと思っています。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp SETF Advent Calendar 2018 14日目 》

setf系構文の紹介ですが、今回は、Macro Forms as Placesの紹介です。
Macro Forms as Placesというと何のことだかさっぱりという感じですが、単にマクロを定義したらsetf定義もオマケで付いてきちゃった、という感じのものです。

例を挙げると、

(defmacro kar (x)
  `(car ,x))
(kar (list 0 1 2))
→ 0 

という定義があった場合、setfの定義は何もしていませんが、下記のようなものが動きます。

(let ((list (list 0 1 2)))
  (setf (kar list) 42)
  list)
→ (42 1 2) 

ローカルマクロでも可

(macrolet ((qar (x)
             `(car ,x)))
  (let ((list (list 0 1 2)))
    (setf (qar list) '())
    (push 42 (qar list))
    list))
→ ((42) 1 2) 

setf場所にマクロで定義したフォームで使えるというのがMacro Forms as Placesです。

Macro Forms as Placesを利用する場合の注意点ですが、マクロ展開後のフォームが、setfで解釈できる状態になっていなければなりません。

具体例を挙げると、prognには、標準ではsetf定義がないので、最外周にprognが現われるような書き方をすればエラーになります。

;; OK

(defmacro kar (x)
  `(car ,x))
;;; NG
(defmacro kar (x)
  `(progn (car ,x)))

まとめ

うまくはまれば、便利に使えるMacro Forms as Places。 活用してみては如何でしょうか。

類似の過去記事

• Macro Forms as Places

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp SETF Advent Calendar 2018 13日目 》

setf系構文の紹介ですが、今回は、define-modify-macroの紹介です。

define-modify-macroは、簡単に説明するなら、(setq x (fn x))のようなパターンを簡潔に(fnf x)と書けるようにする便利定義構文なのですが、このようなパターンが頻出する訳でもないので、普段はそんなに使うこともない印象があります。

define-modify-macroで何か定義してみる

(setq x (cdr x))

というパターンはそこそこ使いますが、define-modify-macroでcdrfでも定義してみましょう。

(define-modify-macro cdrf () cdr)
(let ((x (list 0 1 2)))
  (cdrf x)
  x)
→ (1 2) 

まあ、実質同じことをするビルトインマクロにpopがありますが……。
一応返り値が違います。

定義構文の注意点として、代入にされる場所となる変数が先頭に来て、さらにそれが定義構文中には現われない、という点です。
cdrの場合は1引数なので、0引数で記述します。

define-modify-macroを使えば役に立ちそうな立たなそうな構文を大量生産できます。

(define-modify-macro listf (&rest args) list)
(let ((x (list 0 1 2)))
  (list x 1 2))
→ ((0 1 2) 2 3 4) 
(define-modify-macro =f (&rest args) =)
(let ((x 0)
      (y 1))
  (=f x y )
  (list x y))
→ (nil 1) 

appendf、nconcf等々は定番アイテムで、色々なユーティリティライブラリに含まれています。
まあ、ライブラリを読み込むのが面倒な場合には、簡単なので定義してしまっても良いでしょう。

modify-macrolet

define-modify-macroは大域定義になるのですが、7年程前にローカル構文版を思い付いて作ったことがありました。

• GitHub: g000001/modify-macrolet

これを使うと、

(modify-macrolet ((nconcf (&rest args) nconc))
  (let ((x nil))
    (nconcf x (list 0 1 2 3))
    x))

のように大域の名前を汚染することなくローカルに書くことが可能になります。

ちなみに、個人的には定義してから7年間一度も使ったことはないですが、ご興味のある方は如何でしょうか。
また、modify-macroletを自作してみるのも一興かなと思います。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 13日目 》

前回に引き続き、メソッドコンビネーション元祖のFlavorsに標準装備されていたメソッドコンビネーションを眺めたり再現してみたりしようと思います。

メソッドの返り値を順繰りに次のメソッドに送っていく:pass-onの再現がしたくて苦戦していましたが、なんとか形にできました。

Flavorsの:pass-onの挙動を確認してみる

とりあえず、LMI Lambdaのエミュレータで挙動が確認できたのですが、こんな感じでした。

(defflavor a () ()
  (:method-combination (:pass-on (:base-flavor-last) :m)))
(defflavor b () (a))
(defmethod (a :m) (x y)
  (values (list :a x) (1+ y)))
(defmethod (b :m) (x y)
  (values (list :b x) y))
(send (make-instance 'b) :m 0 1)
→ (:a (:b 0))
   2

aを継承するbという2つのflavorに、それぞれmを:pass-onで定義し、bのインスタンスでmを呼び出すと、b.mの返り値をa.mが受け取るようになります。
:base-flavor-lastなのでb→aの順番ですが、:base-flavor-firstにすれば、逆にもできます。

:pass-onが多値で返す意味が分からなかったのですが、良く考えると、メソッドの引数が複数になる場合は、多値かリストにして対応するしかなく、リストだと受取側の引数のインターフェイスを変更しないといけないので、多値で返すしかないですね。なるほど。

Common Lispで再現してみる

MOPのmake-method-lambda、compute-effective-methodあたりでどうにかできないか検討しましたが、call-methodフォームを作成して、また分解して、という感じになってしまうので、call-methodをスルーして、メソッドの関数をmethod-functionで取り出して直接呼ぶことにしました。

(ql:quickload :closer-mop)
;; LispWorks/Allegro CL
(define-method-combination :pass-on ()
  ((ms ()))
  (:arguments &rest args)
  (let ((vs (gensym "vars-")))
    `(let* ((,vs ,args)
            ,@(loop :for m :in ms 
                    :collect `(,vs
                               (multiple-value-list
                                (apply ,(c2mop:method-function m)
                                       ,vs)))))
       (declare (dynamic-extent ,vs))
       (values-list ,vs))))

しかし、メソッドの引数情報が欲しいので、define-method-combinationの:argumentsを指定しているのですが、SBCLだと:argumentsがちゃんと実装されていないようなので&restが使えません。

また、method-functionが返す関数の引数は、args、next-methodsの筈なので、(funcall method-function vs nil)とするのが正しそうですが、LispWorksとAllegro CLでは、(apply method-function vs)でないと上手く動かない謎。

そんなこんなで、まともに動くものができているとは言い難いですが、こんな感じに書けます。

(defclass a () ())
(defclass b (a) ())
(defgeneric m (o x y)
  (:method-combination :pass-on))
(defmethod m ((o a) x y)
  (values o (list :a x) (1+ y)))
(defmethod m ((o b) x y)
  (values o (list :b x) y))
(m (make-instance 'b) 0 1)
→ #<b 40205BA353> 
   (:a (:b 0)) 
   2 

メソッドコンビネーションの展開はこんな感じで別段変なことはしていませんが、どの処理系も何かしらおかしい感じです。
まあ、LispWorksとAllegro CLで動くので良しとしましょう。

(mc-expand #'m :pass-on nil (make-instance 'b) 0 1)
→ 
(let* ((#:|vars-131621| args)
       (#:|vars-131621|
        (multiple-value-list (apply #<Function (method m (b t t)) 4140032074>
                                    #:|vars-131621|)))
       (#:|vars-131621|
        (multiple-value-list (apply #<Function (method m (a t t)) 41400320FC>
                                    #:|vars-131621|))))
  (declare (dynamic-extent #:|vars-131621|))
  (values-list #:|vars-131621|)) 

まとめ

HyperSpecによると、define-method-combinationの:argumentsでは、&restの他に&wholeも使えたりするみたいですが、メジャーな処理系を試してみたところ、まともに:argumentsの機能を実装しているものは無いように思えます。

• CLHS: define-method-combination

SBCLは、ソースを眺める限り&restを処理できていないのですが、今後修正されれば、今回の:pass-onも動くんじゃないかなと思います。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp メソッドコンビネーション Advent Calendar 2018 12日目 》

前回に引き続き、メソッドコンビネーション元祖のFlavorsに標準装備されていたメソッドコンビネーションを眺めたり再現してみたりしようと思います。

本当は、:pass-onの再現がしたいのですが、色々間に合ってないので、:daemon-with-overrideの再現でお茶を濁したいと思います。

:daemon-with-overrideは、Common Lispでいうと、:aroundなしのstandardメソッドコンビネーションの前に門番のメソッドがいるような感じですが、こんな感じに定義できます。

(define-method-combination :daemon-with-override ()
  ((before (:before))
   (after (:after))
   (primary ())
   (override (:override)))
  `(or 
    ,@(and override `((call-method ,(car override))))
    (multiple-value-prog1 
        (progn
          ,@(loop :for m :in before :collect `(call-method ,m))
          (call-method ,(car primary) ,(cdr primary)))
      ,@(loop :for m :in (reverse after) :collect `(call-method ,m)))))

細かいオプションは詰めてないですが、これくらいの定義なら空で書けるようになりました。
難解だと思っていたdefine-method-combination構文ですが、10個位定義を書けば、そこそこ覚えられそうですね。

では、使ってみましょう。

(defgeneric foo (x)
  (:method-combination :daemon-with-override))
(defmethod foo ((x T)) x)
(defmethod foo :before ((x T)) (print :before))
(defmethod foo :after ((x T)) (print :after))
(defmethod foo ((x rational))
  `(rational ,(call-next-method)))
(defmethod foo ((x integer))
  `(integer ,(call-next-method)))
(defmethod foo :override ((x number))
  (evenp x))

(foo 8)
→ t 
(foo 9)
▻ :before 
▻ :after 
→ (integer (rational 9)) 

メソッドコンビネーションを展開してみるとこんな感じになります。

(mc-expand #'foo
           :daemon-with-override
           nil
           1)
→
(or (call-method #<standard-method foo (:override) (number) 40201044DB>)
    (multiple-value-prog1
        (progn
          (call-method #<standard-method foo (:before) (t) 402045306B>)
          (call-method
           #<standard-method foo nil (integer) 4130468943>
           (#<standard-method foo nil (rational) 413046892B>
            #<standard-method foo nil (t) 413046961B>)))
      (call-method #<standard-method foo (:after) (t) 4020462243>)))

まとめ

:daemonメソッドコンビネーションに門番がついているというパターンなので、Common Lispでは、:aroundを使えば実現できるパターンですね。

数あるパターンが、Common Lispでは、:aroundとして集約されたという流れが想像できます。

■

HTML generated by 3bmd in LispWorks 7.0.0

《 Lisp SETF Advent Calendar 2018 12日目 》

前回の(setf all)を定義していて気付いたのですが、incfや、push、popはvaluesと組み合わせると処理系によって異なる動作をします。

下記のような例は、SBCLやAllegro CLでは中途半端な動きをしますが、LispWorksではマクロ展開時にエラーになります。

(let ((x 0)
      (y 0))
  (incf (values x y))
  (list x y))
→ (1 nil) or error
(let ((x (list 0 1 2))
      (y (list 1 2 3)))
  (pop (values x y))
  (list x y))
→ ((1 2) nil) or error

もしや、setf以外はvaluesを取れないのかと思い、HyperSpecを確認してみましたが、5.1.2.3 VALUES Forms as Placesでもvaluesはsetf以外では機能しない、とは書いてありません。

間接的な定義がされている場合もあるので、それらしきものを探してみましたが、setfベースのマクロについての定義があります。

• 5.1.3 Treatment of Other Macros Based on SETF

decf、pop、pushnew、incf、push、remfはdefine-modify-macroで定義されているような挙動をする的な解釈が成立しそうな雰囲気もありますが、 define-modify-macroのAPIからすると、関数の引数として値を処理するので、多値は扱えません。
define-modify-macroで定義すれば、incfのようなものは、

(let ((x 0)
      (y 0))
  (setf (values x y)
        (values (1+ (values x y))))
  (list x y))
→ (1 nil) 

のように展開されると思われるので、中途半端な返り値になっている理由も合点はいきます。

多値を扱いたい

とりあえず、多値を扱えるフォームはどんな感じになるか定義して眺めてみます。

incfの多値版は、こんな感じに定義できるかなと思います。

(defmacro incf* (place &optional (delta 1) &environment env)
  (multiple-value-bind (dummies vals newval setter getter)
                       (get-setf-expansion place env)
    (declare (ignore dummies vals setter))
    (let ((deltas (loop :for () :on newval :collect (gensym))))
      `(multiple-value-bind ,newval
                            ,getter
         (setf (values ,@deltas) 
               ,(if (eql 1 delta)
                    `(values ,@(loop :for () :on deltas :collect 1))
                    delta))
         (setf ,getter
               (values ,@(mapcar (lambda (v d)
                                   `(incf ,v ,d))
                                 newval
                                 deltas)))))))
(let ((x 0)
      (y 1))
  (incf* (values x y) (values 1 10))
  (list x y))
→ (1 11) 

popの多値版はこんな感じ

(defmacro pop* (place &environment env)
  (multiple-value-bind (dummies vals newval setter getter)
                       (get-setf-expansion place env)
    (declare (ignore dummies vals setter))
    (let ((retvars (loop :for () :on newval :collect (gensym))))
      `(multiple-value-bind ,newval
                            ,getter
         (let (,@(mapcar (lambda (a d)
                           `(,a (car ,d)))
                         retvars
                         newval))
           (setf ,getter
                 (values ,@(mapcar (lambda (v)
                                     `(cdr ,v))
                                   newval)))
           (values ,@retvars))))))
(let ((x (list 0 1 2))
      (y (list 0 1 2)))
  (pop* (values x y))
  (list x y))
→ ((1 2) (1 2)) 

VALUES Forms as Placesを処理できるdefine-modify-macro*のようなものを定義してみても良いかもしれません。

まとめ

どうせコンパイル時に展開すると思うのでVALUES Forms as Placesを処理できても良いと思うのですが、何か事情があるのでしょうか。