MOP vs マクロ (7): Gaucheのpropagatedスロット再現
Posted 2019-03-04 22:54:25 GMT
今回のMOP vs マクロは、Gaucheのpropagatedスロット再現で比較してみたいと思います。
propagatedスロットについてはブログでの紹介記事に詳しいですが、合成した部品のスロットにアクセスする際に子コンポーネントのスロットが親のスロットとしてアクセスできる、というものです。
マクロ篇
そもそもGaucheのpropagatedスロットが想定している利用法からするとマクロで実現してみようというのは色々と無理があるのですが、色々捨てて挙動だけ同じにしました。
(defpackage "6401746F-BD45-5DB6-BD1D-B29A1EFA0494"
(:use :c2cl))(cl:in-package "6401746F-BD45-5DB6-BD1D-B29A1EFA0494")
(defmacro with-slots/propagation ((&rest specs) obj &body body)
(etypecase specs
(null
`(with-slots () ,obj
,@body))
((cons atom null)
(let ((_obj (gensym "_obj")))
`(let ((,_obj ,obj))
(with-slots (,(car specs)) ,_obj
(with-slots/propagation (,@(cdr specs)) ,_obj
,@body)))))
(cons
(destructuring-bind (target-slot slots) (car specs)
(let ((_obj (gensym "_obj")))
`(let ((,_obj ,obj))
(with-slots (,@slots) (slot-value ,_obj ',target-slot)
(with-slots/propagation (,@(cdr specs)) ,_obj
,@body))))))))
(defclass rect ()
((width :initform 0 :initarg :width)
(height :initform 0 :initarg :height)))(defclass viewport ()
((dimension :initform (make-instance 'rect))
(width :initarg :width)
(height :initarg :height)))
(let ((obj (make-instance 'viewport)))
(with-slots/propagation ((dimension (width height))) obj
(setq width 42 height 42))
(describe (slot-value obj 'dimension)))
;>> #<rect 40200074CB> is a rect
;>> width 42
;>> height 42
当初の目的からは外れていますが、局所的にオブジェクトを合成したりするのには使えなくもないかも。
(暗黙の規約が多過ぎますが)
MOP篇
マクロでの実現はやりたいことの中身が全部外側に露出してしまっていますが、これをMOPで内側に収めます。
Gaucheでは、compute-get-n-setという便利なメソッドがあるので圧縮して記述できていますが、AMOP作法だと長くなります。
さらに、standard-instance-accessの利用でアクセス速度向上を狙ってみたので、より長くなりました。
(ql:quickload '(closer-mop))(defpackage "5ADAD164-D620-594D-A9C7-8E192966CA64"
(:use :c2cl))
(cl:in-package "5ADAD164-D620-594D-A9C7-8E192966CA64")
(defclass propagated-slot-class (standard-class)
())
(defmethod validate-superclass ((c propagated-slot-class) (sc standard-class))
T)
(defclass propagated-slot-definition (standard-slot-definition)
((propagate-to :initform nil
:initarg :propagate
:initarg :propagate-to
:accessor propagated-slot-definition-propagate-to)
(propagate-to# :initform nil
:accessor propagated-slot-definition-propagate-to#)))
(defmethod slot-definition-allocation ((slotd propagated-slot-definition))
:propagated)
(defmethod (setf slot-definition-allocation) (allocation (slotd propagated-slot-definition))
(unless (eq allocation :propagated)
(error "Cannot change the allocation of a ~S"
slotd))
allocation)
(defconstant <propagated-direct-slot-definition>
(defclass propagated-direct-slot-definition (standard-direct-slot-definition propagated-slot-definition)
()))
(defmethod direct-slot-definition-class ((class propagated-slot-class) &rest initargs)
(if (eq (getf initargs :allocation) :propagated)
<propagated-direct-slot-definition>
(call-next-method)))
(defconstant <propagated-effective-slot-definition>
(defclass propagated-effective-slot-definition (standard-effective-slot-definition propagated-slot-definition)
()))
(defmethod effective-slot-definition-class ((class propagated-slot-class) &rest initargs)
(if (eq :propagated (getf initargs :allocation))
<propagated-effective-slot-definition>
(call-next-method)))
(defmethod compute-effective-slot-definition ((class propagated-slot-class) name direct-slot-definitions)
(declare (ignore name))
(let ((effective-slotd (call-next-method)))
(dolist (slotd direct-slot-definitions)
(when (typep slotd 'propagated-slot-definition)
(setf (propagated-slot-definition-propagate-to effective-slotd)
(propagated-slot-definition-propagate-to slotd))
(return)))
effective-slotd))
(defmethod finalize-inheritance :after ((class propagated-slot-class))
(let ((slotds (class-slots class)))
(dolist (sd slotds)
(when (typep sd 'propagated-slot-definition)
(setf (propagated-slot-definition-propagate-to# sd)
(slot-definition-location (find (propagated-slot-definition-propagate-to sd)
slotds
:key #'slot-definition-name)))))))
#-lispworks
(defmacro slot-foo (fctn class object slotd)
(declare (ignore class))
`(,fctn
(standard-instance-access ,object
(propagated-slot-definition-propagate-to# slotd))
(slot-definition-name ,slotd)))
#-lispworks
(progn
(defmethod slot-value-using-class
((class propagated-slot-class) object (slotd propagated-slot-definition))
(slot-foo slot-value class object slotd))
(defmethod (setf slot-value-using-class)
(value (class propagated-slot-class) object (slotd propagated-slot-definition))
(setf (slot-foo slot-value class object slotd)
value))
(defmethod slot-boundp-using-class
((class propagated-slot-class) object (slotd propagated-slot-definition))
(slot-foo slot-boundp class object slotd))
(defmethod slot-makunbound-using-class
((class propagated-slot-class) object (slotd propagated-slot-definition))
(slot-foo slot-makunbound class object slotd))
(defmethod slot-exists-p-using-class
((class propagated-slot-class) object (slotd propagated-slot-definition))
(slot-foo slot-exists-p class object slotd))
);;; おまけ:LispWorksの場合
#+lispworks
(defmacro slot-foo (fctn class object slot-name)
`(let ((slotd (find ,slot-name (class-slots ,class) :key #'slot-definition-name)))
(if (typep slotd 'propagated-slot-definition)
(,fctn
(standard-instance-access ,object
(propagated-slot-definition-propagate-to# slotd))
,slot-name)
(call-next-method))))
#+lispworks
(progn
(defmethod slot-value-using-class
((class propagated-slot-class) object slot-name)
(slot-foo slot-value class object slot-name))
(defmethod (setf slot-value-using-class)
(value (class propagated-slot-class) object slot-name)
(let ((slotd (find slot-name (class-slots class) :key #'slot-definition-name)))
(if (typep slotd 'propagated-slot-definition)
(setf (slot-value (standard-instance-access object
(propagated-slot-definition-propagate-to# slotd))
slot-name)
value)
(call-next-method))))
(defmethod slot-boundp-using-class
((class propagated-slot-class) object slot-name)
(slot-foo slot-boundp class object slot-name))
(defmethod slot-makunbound-using-class
((class propagated-slot-class) object slot-name)
(slot-foo slot-makunbound class object slot-name))
(defmethod slot-exists-p-using-class
((class propagated-slot-class) object slot-name)
(slot-foo slot-exists-p class object slot-name)))
試してみる
(defclass rect ()
((width :initform 0 :initarg :width)
(height :initform 0 :initarg :height)))(defclass viewport ()
((dimension :initform (make-instance <rect>))
(width :allocation :propagated :propagate dimension
:initarg :width)
(height :allocation :propagated :propagate dimension
:initarg :height))
(:metaclass propagated-slot-class))
(let ((vp (make-instance 'viewport' :width 42 :height 42)))
(describe vp)
(describe (slot-value vp 'dimension)))
;>> #<viewport 4020098D8B> is a viewport
;>> dimension #<rect 4020098DBB>
;>> width 42
;>> height 42
;>> #<rect 4020098DBB> is a rect
;>> width 42
;>> height 42
速度比較
LispWorksだと素のインスタンス生成/スロットアクセスに比較して大体1.5倍程度の遅さで済んでいるようです。
(defclass c000001 ()
((x :initform 0)
(y :initform 0)
(z :initform 0)))(let ((times 1000000)
(ans 0))
(time (dotimes (i times)
(slot-value (make-instance 'viewport) 'width)))
(time (dotimes (i times)
(slot-value (make-instance 'c000001) 'x)))
ans)
Evaluation took:
0.686 seconds of real time
0.680000 seconds of total run time (0.680000 user, 0.000000 system)
99.13% CPU
2,258,481,555 processor cycles
95,986,800 bytes consed
Evaluation took:
0.413 seconds of real time
0.410000 seconds of total run time (0.410000 user, 0.000000 system)
99.27% CPU
1,360,213,671 processor cycles
64,028,672 bytes consed
まとめ
今回は、マクロ向きのお題ではありませんでしたが、動作の内容はMOPの内側か外側かの違いだけではありました。
MOPで組む前に、マクロで適当に書いてみて動作を考える、というもの場合によっては、悪くないかもしれません。
■
HTML generated by 3bmd in LispWorks 7.0.0
DEFUN 50歳おめでとう
Posted 2019-02-28 15:00:00 GMT
Common Lispでお馴染のdefun。
ClojureだとdefnでCommon Lispと同じくデ(ィ)ファンと読むらしいですが、Jon L White氏によってMACLISPに導入されたのが、50年前の今日、1969-03-01でした。
3/1/69 JONL THE CURRENT VERSION OF LISP, "LISP 102", HAS
THE FOLLOWING AS-YET UNDOCUMENTED FEATURES:
1)"DEFUN" IS AN FSUBR USED TO DEFINE
FUNCTIONS. EXAMPLES ARE
(DEFUN ONECONS (X) (CONS 1 X))
WHICH IS EQUIVALENT TO
(DEFPROP ONECONS
(LAMBDA (X) (CONS 1 X)
EXPR)
AND (DEFUN SMASH FEXPR (L) (RPLACD L NIL))
IS EQUIVALENT TO
(DEFPROP SMASH
(LAMBDA (L) (RPLACD L NIL))
FEXPR)
THE NOVEL FEATURE OF "DEFUN" IS THAT ONE NEED
NOT BE SO CONCERNED WITH BALANCING
PARENTHESES AT THE VERY END OF THE FUNCTION
DEFINITION, SINCE THE TYPE FLAG MAY BE
OMITTED IF IT IS "EXPR", AND APPEARS NEAR
THE FRONT OF THE "DEFUN" LIST IF IT IS SOME
OTHER. ALSO, THE "LAMBDA" NEED NOT BE
DIRECTLY INSERTED.
defun誕生以前は、defpropでシンボルのexprや、fexpr、macroプロパティに関数定義をセットしていたようです。
ちなみに、defunとは別の流儀にdeがありますが、こちらは、MIT LISP 1.6(後のPDP-6 LISP/MACLISP)がスタンフォード大学に導入された後にdefunと同様の目的で考案されたものです。
defunは当初、通常の関数(expr)だけでなくマクロ等の各種関数を定義できました。
exprの定義は、defun foo (x)でfexprの定義はdefun foo fexpr (x)とし、同様にマクロは、defun foo macro (x)で定義可能です。
これらは、Common Lispの祖先のLisp Machine Lispで、各種専用構文に分岐します。
上述のStanford LISP 1.6の場合は、exprは、de、fexprは、df、マクロは、dmと二文字の専用構文となっていますが、defunの方は、先祖のdefpropの影響を引き摺ったのかもしれません。
50年も生き延びたdefun構文ですが、100歳まで生き残るでしょうか。
■
HTML generated by 3bmd in LispWorks 7.0.0
Common Lispにおいて(lambda (x) ...)は関数の名前なのかどうか
Posted 2019-02-23 18:23:58 GMT
たまに、Common Lispの仕様では(lambda (x) ...)を関数の名前として定められている、というような話がされることがあります。
しかし、結論としては、ANSI Common Lisp規格では関数の名前ではありません。
今回は、その辺りを調べてまとめてみました。
ANSI Common Lisp規格での関数の名前
(lambda (x) ...)は、ANSI Common Lisp規格では、lambda expressionと呼びますが、その説明を読むとfunction nameが位置する場所にあるlambdaから始まるリスト、のように持って回った説明がされています。
とりあえず、lambda expressionの方は置いておいて、function nameの方を確認すると、シンボルもしくは、(setf シンボル)というリストがfunction nameとなっています。
Common Lisp(1984)での関数の名前
しかし、CLtL1でお馴染のCommon Lisp(1984)での記述を確認してみると、ANSI規格に比べると記述は曖昧で、関数名としてのシンボルと、ラムダ式を同一視しているような記述ではありました。
CLtL1: 5.2 Functions
There are two ways to indicate a function to be used in a function call
form. One is to use a symbol that names the function. This use of
symbols to name functions is completely independent of their use in
naming special and lexical variables. The other way is to use a
lambda-expression, which is a list whose first element is the symbol
lambda. A lambda-expression is not a form; it cannot be
meaningfully evaluated. Lambda-expressions and symbols, when used in
programs as names of functions, can appear only as the first element of a
function-call form, or as the second element of the function
special form. Note that symbols and lambda-expressions are treated as
names of functions in these two contexts. This should be
distinguished from the treatment of symbols and lambda-expressions as
function objects, that is,
objects that satisfy the predicate functionp,
as when giving such an object to apply or funcall to be
invoked.
これはANSI規格へ向けての中間報告であるCLtL2(1990)でも同様です。
この記述をうけてか、竹内郁雄先生の1980年代の著作である「初めての人のためのLisp」11章の脚注にもこんな記述があります。
Common Lispではこのリストを，関数実体を表わす一種の"名前"と呼んでいます。
ちなみに、増補改訂版(2010)では、脚注から本文の先生の台詞に昇格して
Common Lispではこのリストを，関数実体を表わす一種の"名前"であるとしておる
となっています。 まあ、「一種の“名前”」となっているので、どうとでも解釈できそうです。
Common Lisp(1984)からANSI Common Lisp(1994)までに何が変化したのか
ANSI Common Lisp(1994)は、オブジェクト指向システムやコンディションシステムの追加等が目立つところですが、それまで曖昧だった概念や記述が大分整理されました。
function nameとlambda expressionが分離した背景については、Issue FUNCTION-NAME Writeupに記録があります。
まず、function nameについての整理があり、function、fdefinition、defun、fboundp、fmakunbound等々、関数の名前を取るものの整理がされ、(setf ...)が新しく関数名とされました。
これを推進して、lambda expressionを関数名として扱うかの提案が、FUNCTION-NAME:LARGEの12番にあります。
12. Declare that any lamba expression (i.e., a list whose car is LAMBDA and
whose cdr is a well-formed lambda argument list and body) is a function
name. lambda expressionが名前となれば、
(fmakunbound (lambda () ...))のようなケースも考えていくことになると思うのですが、しかし、結局、lambda expressionが無名関数を表す慣習からすると、それをもって名前とするのは矛盾としています。
名は体を表すといいますが、lambda expressionは体が体を表してしまっているというところでしょうか。
Lambda expressions are often thought to denote "anonymous" functions, so
it may seem paradoxical to treat them as names. The paradox is only
apparent, since the expression itself has the properties of a Lisp
function name: It is (typically) a cons tree which can be read, printed,
and stored in source files, and it denotes a well-defined Lisp function.ここからどのような投票が行なわれ、どう決定されたかの資料はみあたらないのですが、12番の提案は採用されなかったのは確かで、function nameにlambda expressionは含まれることは無かった、ということでしょう。
まとめ
年配の方々はもうしょうがないと思いますが、若者はANSI Common Lisp規格を読みましょう。
また、CLtL2はCLtL1からANSI Common Lispまでの中間報告であり規格ではありませんので、CLtL1/2で得た知識は一度ANSI Common Lisp規格でどう変更された/されていないのかの確認をしましょう。
■
HTML generated by 3bmd in LispWorks 7.0.0
MOP vs マクロ (6)
Posted 2019-02-20 18:53:42 GMT
今回は前回に引き続きECLOSネタから、
- instance-recording-class (get to instances from their class, but allow their garbage collection).
でMOP vs マクロ比較をしてみたいと思います。
インスタンス生成を何らかの形で記録するというのはAMOPの3.1章にも出てくる定番ネタです。
この機能の実現は、インスタンス生成で使うmake-instanceに記録を行う関数のフックをかけてやればOKでしょう。
加えて、ECLOSではインスタンスを記録しつつもGCされたら消えるとのことなのですが、これは弱参照リストかなにかにすれば、これもOKでしょう。
ということで書いてみました。
MOPでの実装
LispWorksとSBCLで弱参照のシークエンスを物色してみましたが、弱参照の配列にしてみました。
LispWorksでは、weak-arrayというものがありadjustableなのですが、SBCLにはないので、結局make-weak-pointerで包んでいます。
trivial-garbageを利用すればいくらか可搬性は増すかもしれません。
(cl:in-package :cl-user)(ql:quickload :closer-mop)
(defpackage "d5fc135c-3bcf-4976-9a9e-e6b92c12bd9d"
(:use :c2cl :alexandria))
(in-package "d5fc135c-3bcf-4976-9a9e-e6b92c12bd9d")
(defun make-weak-vector (size &rest initargs)
(declare (dynamic-extent initargs))
#+lispworks (apply #'hcl:make-weak-vector size initargs)
#+sbcl (apply #'make-array size :element-type 'sb-ext:weak-pointer initargs))
(defclass instance-recording-class (standard-class)
((instance-record :initform (make-weak-vector 0 :adjustable T :fill-pointer 0)
:accessor class-instance-record)))
(defmethod validate-superclass ((c instance-recording-class) (sc standard-class))
T)
(defmethod make-instance :around ((class instance-recording-class) &rest initargs)
(let* ((inst (call-next-method))
#+sbcl (inst (sb-ext:make-weak-pointer inst)))
(vector-push-extend inst (class-instance-record class))
inst))
(defun reset-instance-record (class)
(setf (class-instance-record class)
(make-weak-vector 0 :adjustable T :fill-pointer 0)))
試してみる
(defconstant <zot>
(defclass zot ()
((a :initform 42))
(:metaclass instance-recording-class)))(dotimes (i 8)
(make-instance <zot>))
(class-instance-record <zot>)
#+sbcl
→#(#<weak pointer: #<zot {10349DBA73}>> #<weak pointer: #<zot {10349ECDF3}>> #<weak pointer: #<zot {10349ECE63}>> #<weak pointer: #<zot {10349ECEE3}>>
#<weak pointer: #<zot {10349ECF33}>> #<weak pointer: #<zot {10349ECFD3}>> #<weak pointer: #<zot {10349ED023}>> #<weak pointer: #<zot {10349ED073}>>)
#+lispworks
→ #(#<zot 4020034723> #<zot 4020034B43> #<zot 4020034EAB> #<zot 4020035213>
#<zot 402003557B> #<zot 40200358E3> #<zot 4020035C4B> #<zot 4020035FB3>)
#+lispworks (hcl:gc-all)
#+sbcl (sb-ext:gc :full t)
(class-instance-record <zot>)
#+sbcl
→ #(#<broken weak pointer> #<broken weak pointer> #<broken weak pointer> #<broken weak pointer> #<broken weak pointer> #<broken weak pointer>
#<broken weak pointer> #<broken weak pointer>)
#+lispworks
→ #(nil nil nil nil nil nil nil nil)
;; (clear-instance-record <zot>)
SBCLのほうはweak-pointerオブジェクトで包まれるのでちょっと扱いが面倒ですが、まあこんなものでしょう。
allocate-instanceにフックをかけるのでは駄目なのか
AMOPの例でもこういう記録系の拡張は、make-instanceにフックをかけますが、生成ならばallocate-instanceへのフックでも良さそうです。
両者で何が違うのか考えてみましたが、class-prototypeを実行するとプロトタイプの生成でallocate-instanceが呼ばれるので、クラスのプロトタイプインスタンスも含みたい場合はallocate-instanceの方が良いのでしょう。
恐らく、インスタンス記録系は、クラスのプロトタイプインスタンスは大抵除外して考えそうなので、make-instanceの方が自然かと思います。
allocate-instanceを利用した場合
(defmethod allocate-instance :around ((class instance-recording-class) &rest initargs)
(let* ((inst (call-next-method))
#+sbcl (inst (sb-ext:make-weak-pointer inst)))
(vector-push-extend inst (class-instance-record class))
inst))(defconstant <bar>
(defclass bar ()
((a :initform 42))
(:metaclass instance-recording-class)))
(class-instance-record <bar>)
→ #()
(class-prototype <bar>)
→ #<bar 402008BEE3>
(class-instance-record <bar>)
→ #(#<bar 402008BEE3>)
マクロで考えてみた
あまりこういうのはマクロに向いていない気もしますが、比較のために書いてみました。
(defvar *instance-recording-table*
(make-hash-table))(defmacro with-instance-recording ((type) &body form)
(with-unique-names (inst)
`(let* ((,inst (progn ,@form))
#+sbcl (,inst (sb-ext:make-weak-pointer ,inst)))
#-sbcl (check-type ,inst ,type)
#+sbcl (check-type (sb-ext:weak-pointer-value ,inst) ,type)
(vector-push-extend ,inst
(or (gethash ',type *instance-recording-table*)
(setf (gethash ',type *instance-recording-table*)
(make-weak-vector 0 :adjustable T :fill-pointer 0))))
,inst)))
(defun get-instance-record (type)
(values (gethash type *instance-recording-table*)))
(defun reset-instance-record (type)
(setf (gethash type *instance-recording-table*)
(make-weak-vector 0 :adjustable T :fill-pointer 0)))
試してみる
(defclass quux ()
((x :initform 0)))(dotimes (i 8)
(with-instance-recording (quux)
(make-instance 'quux)))
(get-instance-record 'quux)
→ #(#<quux 40200A1413> #<quux 40200A26A3> #<quux 40200A351B> #<quux 40200A4393>
#<quux 40200A520B> #<quux 40200A6083> #<quux 40200A6EFB> #<quux 40200A7D73>)
(hcl:gc-all)
(get-instance-record 'quux)
→ #(nil nil nil nil nil nil nil nil)
マクロなのでクラスオブジェクト以外にも使えます。
(というかそういう風に作っただけ)
(defstruct sss a b c)(dotimes (i 8)
(with-instance-recording (sss)
(make-sss)))
(get-instance-record 'sss)
→ #(#S(sss :a nil :b nil :c nil) #S(sss :a nil :b nil :c nil)
#S(sss :a nil :b nil :c nil) #S(sss :a nil :b nil :c nil)
#S(sss :a nil :b nil :c nil) #S(sss :a nil :b nil :c nil)
#S(sss :a nil :b nil :c nil) #S(sss :a nil :b nil :c nil))
(hcl:gc-all)
(get-instance-record 'sss)
→ #(nil nil nil nil nil nil nil nil)
まとめ
インスタンスの記録についてMOPとマクロで比較してみましたが、元がMOP向きな問題だけにさすがにMOPの方がすっきりします。
しかし、実現している内容はマクロ版も大して変わらないので、あとは使い勝手がどうなるか、でしょうか。
■
HTML generated by 3bmd in LispWorks 7.0.0
MOP vs マクロ (5)
Posted 2019-02-18 21:04:14 GMT
前回のlet*-like slot initialization semanticsはマクロ主体での実装でしたが、今回はMOP主体でチャレンジです。
しかし、defclassが周囲のレキシカル変数を取り込むので何にせよ全体はマクロでまとめる他なさそうですが、そこは諦めます。
あれこれ試行錯誤しましたが、今回の方針は、
let*風の逐次初期化を実行する関数を収めるスロットを付ける (direct-slot-definitionに追加)- メタクラスにインスタンスの初期化をする関数を収めるスロットを付ける
(
class-let*-initfunction) compute-slotsでスロット構成を生成する際に、追加したスロットの初期化関数をまとめる- まとめた関数を
shared-initializeで呼ぶ
shared-initializeで呼ばれる関数ですが、下記のようなものを生成します。
初期化されるインスタンスを引数に取り、内部では、専らstandard-instance-accessを使って読み書きします。
(lambda (obj)
(symbol-macrolet ((a (standard-instance-access obj 0))
(b (standard-instance-access obj 1)))
(when (eq unbound-marker (standard-instance-access obj 0))
(setf (standard-instance-access obj 0)
(funcall #<Function 1 subfunction of (lw:top-level-form 1) 4060007E8C>
nil
nil)))
(when (eq unbound-marker (standard-instance-access obj 1))
(setf (standard-instance-access obj 1)
(funcall #<Function 2 subfunction of (lw:top-level-form 1) 4060007E34>
a
nil)))
(when (eq unbound-marker (standard-instance-access obj 2))
(setf (standard-instance-access obj 2)
(funcall #<Function 3 subfunction of (lw:top-level-form 1) 4060007DAC>
a
b)))))そして、下記がMOPチャレンジ版のコードですが、大したことはしていないのに長くなりました。
(cl:in-package :cl-user)(ql:quickload :closer-mop)
(defpackage :64d0b072-4e6b-44c3-b565-dcf8d4ca63e3
(:use :c2cl)
#+sbcl (:shadowing-import-from :cl :defmethod))
(cl:in-package :64d0b072-4e6b-44c3-b565-dcf8d4ca63e3)
(defconstant unbound-marker
(if (boundp 'unbound-marker)
unbound-marker
(gensym "unbound")))
(defclass let*-slot-class (standard-class)
((let*-slots :initform nil :accessor class-let*-slots :initarg :let*-slots)
(let*-initfunction :accessor class-let*-initfunction :initarg :let*-initfunction)))
(defmethod validate-superclass ((c let*-slot-class) (sc standard-class))
T)
(defclass let*-standard-object (standard-object)
())
(defun process-a-slot (slot)
(loop :with name := (car slot)
:for (k v) :on (cdr slot) :by #'cddr
:when (eq k :initform)
:append `(:initform ,v :initfunction (constantly unbound-marker)) :into initform
:when (eq k :initarg) :collect v :into initargs
:when (eq k :writer) :collect v :into writers
:when (eq k :reader) :collect v :into readers
:when (eq k :accessor) :collect v :into readers :and :collect `(setf ,v) :into writers
:finally (return
`(:name ,name
:initargs ,initargs
,@initform
:writers ,writers
:readers ,readers))))
(defclass let*-direct-slot-definition (standard-direct-slot-definition)
((let*-initfunction :initarg :let*-initfunction :accessor slot-definition-let*-initfunction)))
(defmethod direct-slot-definition-class ((class let*-slot-class) &rest initargs)
(find-class 'let*-direct-slot-definition))
(defmethod compute-slots :around ((class let*-slot-class))
(let* ((let*-slots (class-let*-slots class))
(slots (call-next-method))
(let*-slot#s (loop :for s :in let*-slots
:for pos := (position s slots :key #'slot-definition-name)
:when pos :collect (cons s pos))))
(setf (class-let*-initfunction class)
(compile nil
`(lambda (obj)
(symbol-macrolet (,@(loop :for s :in (butlast let*-slots)
:collect `(,s (standard-instance-access obj ,(cdr (assoc s let*-slot#s))))))
,@(loop :for s :in let*-slots
:for pos := (cdr (assoc s let*-slot#s))
:for argpos :from 0
:collect `(when (eq unbound-marker (standard-instance-access obj ,pos))
(setf (standard-instance-access obj ,pos)
(funcall ,(slot-definition-let*-initfunction
(find s (class-direct-slots class) :key #'slot-definition-name))
,@(replace (make-list (length (cdr let*-slots)))
(subseq (butlast let*-slots) 0 argpos))))))))))
slots))
(defmethod shared-initialize :after
((obj let*-standard-object) slot-names &rest initargs &key &allow-other-keys)
(funcall (class-let*-initfunction (class-of obj)) obj))
(defmacro defclass* (name (&rest superclasses) (&rest slots) &rest class-options)
(loop :with slot-names := (mapcar (lambda (x) (if (consp x) (car x) x))
slots)
:for s :in slots
:for cs := (copy-list (process-a-slot s))
:collect `(,@cs
:let*-initfunction
(lambda (,@(butlast slot-names))
(declare (ignorable ,@(butlast slot-names)))
,(getf cs :initform))) :into canonicalized-slots
:finally (return
`(eval-when (:compile-toplevel :load-toplevel :execute)
(ensure-class ',name
:metaclass 'let*-slot-class
:direct-superclasses (adjoin 'let*-standard-object
',superclasses)
:direct-slots (list ,@(mapcar (lambda (s)
(destructuring-bind (&key name
initargs
initform
initfunction
writers
readers
let*-initfunction
&allow-other-keys)
s
`(list :name ',name
:initargs ',initargs
:initform ',initform
:initfunction ,initfunction
:writers ',writers
:readers ',readers
:let*-initfunction ,let*-initfunction)))
canonicalized-slots))
:let*-slots ',slot-names
,@class-options)))))
動作
(defclass* qqq ()
((a :initform 42 :initarg :a)
(b :initform a :initarg :b)
(c :initform (+ a b) :initarg :c)))(with-slots (a b c) (make-instance 'qqq)
(list a b c))
;=> (42 42 84)
(with-slots (a b c) (make-instance 'qqq :c 0)
(list a b c))
;=> (42 42 0)
(with-slots (a b c) (make-instance 'qqq :b 0)
(list a b c))
;=> (42 0 42)
(with-slots (a b c) (make-instance 'qqq :a 0)
(list a b c))
;=> (0 0 0)
(with-slots (a b c) (make-instance 'qqq :a 0 :b 1)
(list a b c))
;=> (0 1 1)
MOPにして良いことがあるのか
マクロ主体の場合は、スロットアクセスが名前参照ベースなので若干非効率効率ですが、MOPを使えば、standard-instance-access等の効率の良いアクセス方法が使えるので速くできるだろうということで、今回は、standard-instance-accessの利用を軸に組み立ててみました。
素のインスタンス生成〜初期化と比較して、マクロ版は、約1.8倍の時間のところをMOP版では、約1.3倍程度にまで抑えることができました。
まあもっと速くできそうではありますが……。
(defclass let-slot ()
((a :initform 42)
(b :initform 42)
(c :initform 42)))(defclass* let*-slot ()
((a :initform 42 :initarg :a)
(b :initform a :initarg :b)
(c :initform (+ a b) :initarg :c)))
(dc07f5fa-62ee-40a1-ae1a-d1a0f87d19bb::defclass* let*-slot-macro ()
((a :initform 42 :initarg :a)
(b :initform a :initarg :b)
(c :initform (+ a b) :initarg :c)))
計時
(let ((cnt 1000000))
(time
(dotimes (i cnt)
(make-instance 'let-slot)))
(time
(dotimes (i cnt)
(make-instance 'let*-slot)))
(time
(dotimes (i cnt)
(make-instance 'let*-slot-macro))))Timing the evaluation of (dotimes (i cnt) (make-instance 'let-slot))
User time = 1.270
System time = 0.000
Elapsed time = 1.258
Allocation = 1352109704 bytes
0 Page faults
Calls to %EVAL 17000036
Timing the evaluation of (dotimes (i cnt) (make-instance 'let*-slot))
User time = 1.660
System time = 0.000
Elapsed time = 1.654
Allocation = 1352029784 bytes
0 Page faults
Calls to %EVAL 17000036
Timing the evaluation of (dotimes (i cnt) (make-instance 'let*-slot-macro))
User time = 2.260
System time = 0.000
Elapsed time = 2.260
Allocation = 1352020600 bytes
0 Page faults
Calls to %EVAL 17000036
nil
継承した場合にスロットのインデックスの位置関係はどうなるのか
具体的には下記のような場合に、standard-instance-accessが指す先がどのような構成になるのかを把握していないと使えないのですが、
(defclass A ()
((a :initform 0 :initarg :a)
(b :initform 1 :initarg :b)
(c :initform 2 :initarg :c)))(defclass* B (A)
((x :initform 42 :initarg :x)
(y :initform x :initarg :y)
(z :initform (+ x y) :initarg :z)))
(with-slots (a b c x y z) (make-instance 'B :y 1)
(list a b c x y z))
;=> (0 1 2 42 1 43)
AMOPのInstance Structure Protocolの例では、compute-slotsの並び順で、standard-instance-accessのインデックスを決められる的なことが書いてあります。
実際に試してみると、継承した場合、上位クラスのスロット数分だけオフセットしたり(SBCL、LispWorks)名前とスロットの値が一致しなかったり(LispWorks)で、compute-slotsで並べた順がすなわちインデックスとはならない実装があるようです。
しょうがないので、結局名前からインデックスを求めるようにしましたが、私が何か勘違いをしているのか、もしくはこの仕様に準拠している処理系が少ないのか。
まとめ
これまでlet*風にスロットの逐次初期化を2パスで考えてみましたが、shared-initializeを差し替えてしまった方が素直なのかもしれません。
そのうち試してみようかなと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
MOP vs マクロ (4)
Posted 2019-02-11 15:59:28 GMT
MOP vs マクロなネタを探していますが、古えのメールに面白そうなものがあったので、これをどうにかMOP vs マクロの枠内で再現してみることにします。
ちなみに、このECLOSですが、Metaclass libraryとあるように、MOP的なツールを纏めた商用ライブラリだったようです。
メタクラス関係だけで商品になってたというのが凄い。
告知メールによると主なアイテムは、
- self-referent class
- instance-recording-class (get to instances from their class, but allow their garbage collection).
- operating-class (implement recursive operations like
copy-object,equal-object-pwith suscint in-class specifications) - lazy-class (establish inter-slot/access dependencies to avoid initializing slots until they are needed/make-sense)
- attributed-class (arbitrary-depth attributes in slots, great for frame-like programming)
- constrained-class (multi-way constraints and daemons can be stored in and refer transparently to slots).
- An enhanced Delta-Blue constraint solver with a higher-order architecture
for dynamic update of constraint graphs (no
propagate as if graph still unchangedsemantics). - let*-like slot initialization semantics
ですが、定番そうなものから何やら良く分からないものまであります。
今回は、このリストの中からlet*-like slot initialization semanticsをMOPとマクロで再現してみたいと思います。
例のごとくまずはマクロでの実現から始めます。
let*-like slot initialization semantics をマクロで書いてみる
まず、動作の確認ですが、詳細は不明なものの、多分let*のように上方のスロットの値が次のスロットで使えるということなのではないかと思います。
動作例を考えると、下記のようになるかと思いますが、やりたいことが単純な割には実現は面倒臭そうです。
(let ((z 42))
(defclass* qqq ()
((a :initform z :initarg :a :initarg a)
(b :initform a :initarg :b :initarg b)
(c :initform (+ a b) :initarg :c :initarg c))))(with-slots (a b c) (make-instance 'qqq)
(list a b c))
;=> (42 42 84)
(with-slots (a b c) (make-instance 'qqq :c 0)
(list a b c))
;=> (42 42 0)
(with-slots (a b c) (make-instance 'qqq :b 0)
(list a b c))
;=> (42 0 42)
(with-slots (a b c) (make-instance 'qqq :a 0)
(list a b c))
;=> (0 0 0)
(with-slots (a b c) (make-instance 'qqq :a 0 :b 1)
(list a b c))
;=> (0 1 1)
一応の解説ですが、上記のクラス定義フォームを素のdefclassで置き換えた場合、bとcスロットでaとbが未束縛でエラーになります。
変数zに関してはdefclassは外側の変数を取り込めるのでzはレキシカル変数になります。
(let ((z 42))
(defclass ppp ()
((a :initform z :initarg :a :initarg a)
(b :initform a :initarg :b :initarg b)
(c :initform (+ a b) :initarg :c :initarg c))))(make-instance 'ppp)
;!!! The variable a is unbound.
このlet*的な初期化構文のポイントは、let*的な順次初期化は、クラス定義時に行なわれるのではなく、インスタンス(再)初期化時に行なわれるということです。
マクロでどうするか考えてみる
あれこれ考えてみましたが、とりあえずスロットの初期化を2パスにするのが一番簡単そうなので、それで行くことにしました。
- スロットの
:initfunctionに設定する関数でクロージャーを返すようにしインスタンス初期化まで評価を遅らせる - インスタンス初期化時に、スロットの値が保留になっているかを調べて保留状態ならクロージャーを評価し値を設定
という所です。
マクロ展開を眺めるのが一番早いと思うのですが下記のような展開になります。
(defclass* qqq ()
((a :initform 42 :initarg :a)
(b :initform a :initarg :b)
(c :initform (+ a b) :initarg :c)))
===>
(eval-when (:compile-toplevel :load-toplevel :execute)
(let ((#:a368281
(lambda (obj)
(with-slots (a b c) obj (declare (ignorable a b c)) 42)))
(#:b368282
(lambda (obj) (with-slots (a b c) obj (declare (ignorable a b c)) a)))
(#:c368283
(lambda (obj)
(with-slots (a b c) obj (declare (ignorable a b c)) (+ a b)))))
(ensure-class 'qqq
:direct-superclasses
(adjoin 'let*-standard-object 'nil)
:direct-slots
(list (list :name 'a :initargs '(:a) :initform '42 :initfunction (lambda () #:a368281) :writers 'nil :readers 'nil)
(list :name 'b :initargs '(:b) :initform 'a :initfunction (lambda () #:b368282) :writers 'nil :readers 'nil)
(list :name 'c :initargs '(:c) :initform '(+ a b) :initfunction (lambda () #:c368283) :writers 'nil :readers 'nil)))
(defmethod initialize-let*-slots ((obj qqq))
(let ((sname 'a))
(when (slot-boundp obj sname)
(let ((sval (slot-value obj sname)))
(when (eq #:a368281 sval)
(setf (slot-value obj sname) (funcall sval obj))))))
(let ((sname 'b))
(when (slot-boundp obj sname)
(let ((sval (slot-value obj sname)))
(when (eq #:b368282 sval)
(setf (slot-value obj sname) (funcall sval obj))))))
(let ((sname 'c))
(when (slot-boundp obj sname)
(let ((sval (slot-value obj sname)))
(when (eq #:c368283 sval)
(setf (slot-value obj sname) (funcall sval obj)))))))))マクロ定義(およびクラス定義)
(cl:in-package :cl-user)(ql:quickload :closer-mop)
(cl:defpackage :dc07f5fa-62ee-40a1-ae1a-d1a0f87d19bb
(:use :c2cl))
(cl:in-package :dc07f5fa-62ee-40a1-ae1a-d1a0f87d19bb)
(defclass let*-standard-object (standard-object)
())
(defun process-a-slot (slot)
(loop :with name := (car slot)
:for (k v) :on (cdr slot) :by #'cddr
:when (eq k :initform)
:append `(:initform ,v :initfunction ,(coerce `(lambda () ,v) 'function)) :into initform
:when (eq k :initarg) :collect v :into initargs
:when (eq k :writer) :collect v :into writers
:when (eq k :reader) :collect v :into readers
:when (eq k :accessor) :collect v :into readers :and :collect `(setf ,v) :into writers
:finally (return
`(:name ,name
:initargs ,initargs
,@initform
:writers ,writers
:readers ,readers))))
(defgeneric initialize-let*-slots (obj))
(defmethod shared-initialize :after
((obj let*-standard-object) slot-names &rest initargs &key &allow-other-keys)
(initialize-let*-slots obj))
(defmacro defclass* (name (&rest superclasses) (&rest slots) &rest class-options)
(loop :with slot-names := (mapcar (lambda (x) (if (consp x) (car x) x))
slots)
:for s :in slots
:for cs := (copy-list (process-a-slot s))
:for ifn := (gensym (string (getf cs :name)))
:collect cs :into canonicalized-slots
:collect `(,ifn (lambda (obj)
(with-slots (,@slot-names) obj
(declare (ignorable ,@slot-names))
,(getf cs :initform)))) :into bvs
:collect `(let ((sname ',(getf cs :name)))
(when (slot-boundp obj sname)
(let ((sval (slot-value obj sname)))
(when (eq ,ifn sval)
(setf (slot-value obj sname)
(funcall sval obj)))))) :into slot-init-forms
:do (setf (getf cs :initfunction)
`(lambda () ,ifn))
:finally (return
`(eval-when (:compile-toplevel :load-toplevel :execute)
(let (,@bvs)
(ensure-class ',name
:direct-superclasses (adjoin 'let*-standard-object
',superclasses)
:direct-slots (list
,@(mapcar (lambda (s)
(destructuring-bind (&key name
initargs
initform
initfunction
writers
readers
&allow-other-keys)
s
`(list :name ',name
:initargs ',initargs
:initform ',initform
:initfunction ,initfunction
:writers ',writers
:readers ',readers)))
canonicalized-slots))
,@class-options)
(defmethod initialize-let*-slots ((obj ,name))
,@slot-init-forms))))))
まとめ
案外ほとんどMOP的な要素を使わずにマクロのみで実現できてしまいましたが、スコープ的なものを扱うのでマクロの方が得意なのかもしれません。
ちなみに、スロットの:initfunctionは、ANSI Common Lispの規格にはなく、MOPで規定されているものですが、まあこれくらいは良しとしましょう。
さてこれを今後MOP的にして行きたいと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
MOP vs マクロ (3)
Posted 2019-02-03 20:45:41 GMT
前回は、全面的なマクロから、ensure-classを使って若干のMOP利用へと進めましたが、今回は、ensure-class-using-classを利用して、もう一歩進めてみたいと思います。
ensure-class-using-class を利用してみる
ensure-classは関数ということもあり、プロトコルを成しているメソッド群をカスタマイズするという感じではありませんが、ensure-classの下請けのensure-class-using-classは、standard-classをカスタマイズしたメタクラスでディスパッチさせることが可能です。
(defpackage d34ab7fb-8666-4f9c-ac95-833380ffefee
(:use :c2mop :cl)
(:shadowing-import-from :c2mop
:defmethod :standard-class :defgeneric
:standard-generic-function :funcallable-standard-class))(in-package d34ab7fb-8666-4f9c-ac95-833380ffefee)
(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)))
(defclass conc-name-class (standard-class)
((conc-name :initarg :conc-name :accessor class-conc-name)))
(defmethod validate-superclass ((class conc-name-class) (super standard-class))
T)
上記では、standard-classメタクラスのサブクラスとしてconc-name-classメタクラスを定義してみています。
これで、ensure-class-using-classがディスパッチできるようになります。
(defmethod ensure-class-using-class ((class conc-name-class) name
&rest initargs
&key (conc-name (concatenate 'string (string name) ".") conc-name-sup?)
direct-slots
&allow-other-keys)
(when conc-name-sup?
(setq conc-name (car conc-name)))
(setq direct-slots
(loop :for s :in direct-slots
:collect (destructuring-bind (&key name readers writers &allow-other-keys)
s
(let ((aname (slot-name-conc conc-name name)))
`(:name ,name
:readers (,aname ,@readers)
:writers ((setf ,aname) ,@writers))))))
(let ((class (apply #'call-next-method class name :direct-slots direct-slots
initargs)))
(setf (class-conc-name class) conc-name)
class))ensure-classと同じく、ensure-class-using-classが取るキーワード引数は、defclassのクラスオプションが渡ってきますので、以上で下記のように書けます。
(defclass foo ()
(x
y
(z :accessor z))
(:metaclass conc-name-class)
(:conc-name foo.))(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の派生構文ができてしまう
というのがありましたが、:metaclassを一々指定するのは面倒臭いもののdefclassの標準構文に収まりました。
また、
- マクロ内でdefclassのオプションを解析するのがめんどくさい
というのもensure-classが正規化して渡してくれるので、ensure-classよりはすっきりします。
しかし今度もあまりMOP的でない?
しかし、上記のコードを眺めると判るように前回とさして変化ありません。
アクセサの名前に接頭辞を付けるのだから、MOP的にするなら、スロット定義メタオブジェクトをあれこれするのが筋なのではないか、ということになります。
ということで、スロット定義のプロトコルをカスタマイズしてみます。
(defclass conc-name-direct-slot-definition (standard-direct-slot-definition)
((conc-name :initform nil :initarg :conc-name)))(defmethod direct-slot-definition-class ((class conc-name-class) &rest initargs)
(find-class 'conc-name-direct-slot-definition))
(defmethod initialize-instance :around ((sd conc-name-direct-slot-definition) &rest args &key name conc-name)
(let ((aname (slot-name-conc conc-name name))
(inst (call-next-method)))
(pushnew aname (slot-definition-readers sd) :test #'equal)
(pushnew `(setf ,aname) (slot-definition-writers sd) :test #'equal)
inst))
(defmethod ensure-class-using-class ((class conc-name-class) name
&rest initargs
&key (default-conc-name (concatenate 'string (string name) ".") default-conc-name-sup?)
direct-slots
&allow-other-keys)
(when default-conc-name-sup?
(setq default-conc-name (car default-conc-name)))
(apply #'call-next-method
class
name
:default-conc-name default-conc-name
:direct-slots (mapcar (lambda (s)
(if (getf s :conc-name)
s
(list* :conc-name default-conc-name s)))
direct-slots)
initargs))
解説すると、まずデフォルトのstandard-direct-slot-definitionをカスタマイズするために、conc-name-direct-slot-definitionを定義します。
conc-name-direct-slot-definitionの中では、指定された接頭辞をもとにアクセサ名を生成します。
スロット定義では、:conc-nameで接頭辞を指定しますが、スロット定義メタオブジェクトを生成する時のキーワード引数はdefclassのスロットのキーワード引数が正規化されたものになりますので、単純に:conc-nameを追加しておけばOKです。
次に、このスロット定義を呼び出すために、direct-slot-definition-classが返すクラスをconc-name-direct-slot-definitionに設定します。
direct-slot-definition-classが返すクラスでスロット定義を生成するプロトコルなので、スロット定義のサブクラスを作ってカスタマイズしても、これに設定しないと有効にできません。
また、クラス定義の方で指定する接頭辞とスロットで指定する接頭辞を区別したいので、クラス定義の方は、default-conc-nameと変更します。
(defclass conc-name-class (standard-class)
((conc-name :initarg :default-conc-name :accessor class-conc-name)))これでこんな感じに書けます
(defclass bar ()
((x :conc-name bar=)
(y :conc-name bar_)
(z :accessor z))
(:default-conc-name bar.)
(:metaclass conc-name-class))(let ((qqq (make-instance 'bar)))
(with-slots (x y z) qqq
(setq x 42 y 43 z 44))
(incf (bar.z qqq))
(list (bar=x qqq)
(bar_y qqq)
(bar.z qqq)))
→ (42 43 45)
スロットごとに接頭辞を付けて便利なことがあるかは不明ですが、スロット定義のプロトコルに従ったお蔭でおまけ的に別個に指定できたりします。
まとめ
以上、マクロだけでの実現からMOP的なものまでを順に考えてきましたが、MOPの方は作法を憶えるのが面倒臭いです。
まあしかし、MOPの作法は一応標準化されていますので、俺マクロの使い方を憶えるよりは、ましだったりするかもしれません。
■
HTML generated by 3bmd in LispWorks 7.0.0
MOP vs マクロ (2)
Posted 2019-01-23 17:36:05 GMT
長くなりそうなので数回に分けた記事にしようと思っていましたが、前回の記事を書くなかで自分の中では問題は解決してしまったので、続きを書くのをすっかり忘れていました。
それはさておき、前回は、お題を全部マクロで実現した訳ですが、今回は若干MOPよりです。
といっても、MOPが定めている便利ユーティリティを利用するのみでメタオブジェクトをあれこれという訳ではありません。
「マクロだけでがんばる」から「MOPだけでがんばる」の方向に進めて行き、丁度良い落とし所はどの辺りかを探っていければ良いなと考えています。
ensure-class を利用してみる
前回は、defclassのラッパーという感じでしたが、今回はMOPが定めるdefclassを組み立てるための関数であるensure-classを利用します。
ensure-classは、defclassを組み立てるための関数ともいえますし、ensure-classをお化粧したのがdefclassともいえるでしょう。
(setf (fdefinition 'foo) ...)と(defun foo (...) ...)のような関係と考えるとわかりやすいかと思います。
コードは長いので後ろに置きますが、ensure-classを使えばこんな感じのものに構成できます。
(defclass/conc-name foo ()
(x
y
(z :accessor z))
(:conc-name foo.));;; マクロ展開
===>
(eval-when (:compile-toplevel :load-toplevel :execute)
(ensure-class 'foo
:direct-superclasses 'nil
:direct-slots '((:name x :writers ((setf foo.x)) :readers (foo.x))
(:name y :writers ((setf foo.y)) :readers (foo.y))
(:name z :writers ((setf z) (setf foo.z)) :readers (z foo.z)))
:direct-default-initargs 'nil))
(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の派生構文ができてしまう
- マクロ内で
defclassのオプションを解析するのがめんどくさい
の二点がありましたが、ensure-classを使っても別段問題は解消されていません。
ensure-classを使った場合、:accessorは、:writerと:readerの組み合わせとして正規化する必要があるので、見通しが若干良くなるのかも、というところです。
オプションの解析部分をより拡張性のあるものにすれば(例えば総称関数にする等)、汎用的な構文として綺麗にまとめられるかもしれません。
既にこの辺りが落とし所な気はしますが、次回はさらにMOP的にすべくensure-class-using-classの活用を考えてみます。
付録: ensure-class を使ってみた場合の定義例
(defpackage 05d2b99b-651a-4352-ba04-47593339a944
(:use :c2mop :cl)
(:shadowing-import-from :c2mop :defmethod :standard-class :defgeneric :standard-generic-function))(in-package 05d2b99b-651a-4352-ba04-47593339a944)
(eval-when (:compile-toplevel :load-toplevel :execute)
(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 process-a-slot (slot)
(loop :with name := (car slot)
:for (k v) :on (cdr slot) :by #'cddr
:when (eq k :initform)
:append `(:initform ,v :initfunction (lambda () ,v)) :into initform
:when (eq k :writer) :collect v :into writers
:when (eq k :reader) :collect v :into readers
:when (eq k :accessor) :collect v :into readers :collect `(setf ,v) :into writers
:finally (return
`(:name ,name
,@initform
:writers ,writers
:readers ,readers))))
)(defmacro defclass/conc-name (name superclasses slots &rest class-options)
(let* ((conc-name (concatenate 'string (string name) "-"))
(class-options (loop :for opt :in class-options
:if (eq :conc-name (car opt))
:do (when (cadr opt)
(setq conc-name (cadr opt)))
:else :collect opt)))
`(eval-when (:compile-toplevel :load-toplevel :execute)
(ensure-class ',name
:direct-superclasses '(,@superclasses)
:direct-slots '(,@(loop :for s :in (canonicalize-slots slots)
:for aname := (slot-name-conc conc-name (car s))
:collect (process-a-slot `(,@s :accessor ,aname))))
:direct-default-initargs '(,@class-options)))))
■
HTML generated by 3bmd in LispWorks 7.0.0
MOP vs マクロ (1)
Posted 2019-01-13 21:46:09 GMT
オブジェクト指向システムを拡張する際に、痒い所に微妙に手が届かない気がする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標準が利用するキーワードシンボル一覧はどこにある
Posted 2019-01-02 23:43:53 GMT
たまにCommon Lisp標準が利用するキーワードシンボル一覧が欲しい時がありますが、どこにあるんでしょうか。
とりあえずのところは、HyperSpecのインデックスが利用できると思います。
しかし、どこかにキーワードシンボルだけまとめたものがありそうなのですが……。
少し探しても見当らなかったので、HyperSpecを参考に逆引きCommon Lispに記事を作成してみました。
ちなみに、HyperSpecのものは記事からインデックスを自動生成かなにかをしているようでタイポがあったり、コード例に使われているだけのキーワードシンボルも計上されているようです。
まとめ
エディタの補完機能まわりをカスタマイズしているときに関数が利用するキーワードだけを補完して欲しいのですが、まずは補完対象の一覧が欲しいなと思って、ここに至ります。
ひょっとしたら、ANSI Common Lisp規格票には掲載されていたりするかもと思い確認してみましたが、こちらにも無いようです。うーむ。
■
HTML generated by 3bmd in LispWorks 7.0.0
2018年振り返り
Posted 2018-12-31 18:57:12 GMT
毎年振り返りのまとめを書いているので、今回も書いてみます。
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
setfアドベントカレンダー総括
Posted 2018-12-24 15:00:01 GMT
《 Lisp SETF Advent Calendar 2018 25日目 》
メソッドコンビネーションでアドベントカレンダーを開催することを決めてから、もう一品と考えてsetfアドベントカレンダーを開催してみましたが、後半はネタを捻り出すのがきつかったです。
よくよく考えれば、ただの代入機構なので、話題が広げられる余地はあまりないのですが、ファーストクラスの参照を持つLISP方言についてもうちょっと掘り下げて書けたかもしれません(といっても一回分位だと思いますが)
setfアドベントカレンダーのを書いたお蔭で、setfの定義構文の使い分けについて、きっちり把握できたのは収穫かなと思います。
-完-
■
HTML generated by 3bmd in LispWorks 7.0.0
メソッドコンビネーションアドベントカレンダー総括
Posted 2018-12-24 15:00:00 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 25目 》
メソッドコンビネーションでアドベントカレンダーは無謀かなと思いましたが、果してそれなりに無謀でした。
このアドベントカレンダーでの収穫は、eshamsterさんに 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
X3J13 88-003Rのメソッドコンビネーションを探る
Posted 2018-12-23 20:14:57 GMT
《 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にしたものがこちらにありますので、適宜参照してください。
下準備
シンボル名の競合がありそうなので、専用のパッケージを作成します。
(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
setf-expansionの返り値が憶えられない
Posted 2018-12-23 16:28:40 GMT
《 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
setf系便利構文紹介
Posted 2018-12-23 11:08:45 GMT
《 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
MOPでメソッドコンビネーションの仕組みを実装してみよう
Posted 2018-12-23 10:44:01 GMT
《 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のサポートが鬼門なのですが、
- まともに実装している処理系がないっぽい
- 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
setfとメソッドコンビネーションについて掘り下げる
Posted 2018-12-22 10:49:25 GMT
《 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
メソッドコンビネーションとMOPの関係を整理する
Posted 2018-12-21 17:41:46 GMT
《 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とメソッドコンビネーションの兼ね合いですが、
define-method-combinationでメソッド配置を定義(コード生成の定義)compute-effective-methodがコード生成の定義と、総称関数、メソッド、メソッドコンビネーションの各メタオブジェクトからコード(effective-method)を生成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では、
- メソッドコンビネーションごとに、総称関数をサブクラス化する。補助メソッドの特定にはメソッド修飾子を利用。
compute-applicable-methods-using-classesがメソッドを集めてくる- メソッド群を起動する
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
setfで自己代入
Posted 2018-12-19 20:05:20 GMT
《 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
Quicklispのライブラリのメソッドコンビネーションを眺めてみよう
Posted 2018-12-19 18:37:02 GMT
《 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については過去に紹介記事がありますので、そちらをどうぞ。
method-combination-utilities
primary / lax / basic / append/nconc
メソッドコンビネーション定義のためのユーティリティと、有用そうなメソッドコンビネーション定義のライブラリです。
すっかり忘れていましたが、過去に紹介記事も書いていました。
このブログでもmc-expandのようなものを定義していましたが、method-combination-expandみたいなものも定義されています。
メソッドコンビネーションを活用するなら試してみて損はなさそうなユーティリティです。
しかし、LispWorksで動かない様子(PR出そうかな)
まとめ
案外使う人はカジュアルに使っている様子。
メソッドコンビネーションを学んで活用しましょう!
■
HTML generated by 3bmd in LispWorks 7.0.0
メソッドコンビネーションでD風の契約プログラミング: その2
Posted 2018-12-19 12:47:24 GMT
《 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
たまに便利な(setf apply)/(setf values)
Posted 2018-12-19 10:04:13 GMT
《 Lisp SETF Advent Calendar 2018 19日目 》
今回は、たまに便利な(setf apply)/(setf values)を解説してみたいと思います。
(setf values) | VALUES Forms as Places
(setf values)はそこそこ使われているかと思いますが、Common Lisp(1984)の時代から知識の更新がない年配の方々がmultiple-value-setqしか知らないような場面に遭遇することもままあります。
(古い書籍で勉強してしまったので知らなかった、ということもあります)
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)からありますが、配列を多用する人以外は使う機会もないからか、それほど知られていない機能です。
添字のリストだけあって、それを適用したい、ということはあるのですが、(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
マクロ展開でもメソッドコンビネーション
Posted 2018-12-18 15:32:33 GMT
《 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
拡張setf定義を眺める: 解構篇
Posted 2018-12-17 21:05:17 GMT
《 Lisp SETF Advent Calendar 2018 18日目 》
今回は、処理系拡張のsetfのうち解構系の拡張を眺めてみたいと思います。
destructuringの邦訳語はいまいち一定しない感がありますが、中華圏では、ほぼ、解構で通っているようです。
- 例: 解構賦值 | MDN
解構は短くて意味の通りも良い気がするので、本記事では、解構で通します。
(しかし流行らなそうな言葉の響き……)
解構拡張のsetfとは
setfの場所で解構を使うという拡張です。
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
メソッドコンビネーションでD風の契約プログラミング: その1
Posted 2018-12-17 14:20:30 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 17日目 》
契約プログラミングをメソッドコンビネーションを表現するネタは既にあるのですが、
もうちょっと簡潔に書けそうな気がしてきたので、試しに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
拡張setf定義を眺める: 制御構造篇
Posted 2018-12-17 00:05:13 GMT
《 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
メソッドコンビネーションで並列実行
Posted 2018-12-15 21:45:07 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 16日目 》
メソッドコンビネーションは、メソッドの集合をあるコンビネーションで実行することなので並列実行も範疇に入ると思われます。
メソッドコンビネーションで並列実行の例は、そこそこあるだろうと思ってネットをしばらく検索してみましたが、どうやらあまり試してみた例はないようです。
NetCLOSの構文の見た目が、メソッドコンビネーションっぽかったのでソースを確認してみましたが、残念ながら、並列実行のパターンに直接メソッドコンビネーションを活用している訳ではない様子(メッセージ送信のシークエンスに活用してはいるようです)
ちなみに、NetCLOSは、ABCL/1にインスパイアされたアクターベースの並列オブジェクト指向なCLOSのネットワーク拡張です。
メソッドコンビネーションと素朴な並列実行
非常に素朴ですが、各メソッドをスレッドに分配して全部実行してジョインというのは簡単に書けます。
コンビネーションとしては、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
実践SETF定義:ローカルなsetf
Posted 2018-12-15 19:31:30 GMT
《 Lisp SETF Advent Calendar 2018 16日目 》
今回は、ローカルスコープでのsetf定義について考えてみます(ネタがないから)
ローカルスコープでsetfとは
ANSI Common Lispでは、(setf fn)という関数名が使えるということは以前解説したのですが、これはflet/labelsでも勿論使えます。
つまり、ローカルスコープ限定でsetfフォームが書けるということになります。
#'(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
実践SETF定義:defstruct、defclassで定義できるおまけsetf
Posted 2018-12-15 13:52:03 GMT
《 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
New Flavorsのwrapperとwhopperを再現してみよう
Posted 2018-12-15 11:24:57 GMT
《 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
FlavorsのdefwrapperとCommon Lispの:aroundの比較
Posted 2018-12-14 14:48:47 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 14日目 》
Flavorsには、Common Lispのメソッドコンビネーションの:aroundが無いようなのですが、その代わりにdefwrapperという構文があったようです。
defwrapperの発展的解消の結果、:aroundに纏められたのかなと思えてきたのですが、CADRのエミュレータ上でdefwrapperの実際の使い勝手と挙動を確認してみることにしました。
挙動確認のお題ですが、先日のstandardメソッドコンビネーションの説明で:before、:after、primary、:around全部盛りの定義を紹介したものをFlavorsに書き換えて試してみます。
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
実践SETF定義:マクロを定義した場合のおまけsetf
Posted 2018-12-13 18:45:56 GMT
《 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。
活用してみては如何でしょうか。
類似の過去記事
■
HTML generated by 3bmd in LispWorks 7.0.0
実践SETF定義:define-modify-macroで頻出パターンをまとめる
Posted 2018-12-13 14:28:27 GMT
《 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年程前にローカル構文版を思い付いて作ったことがありました。
これを使うと、
(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
Flavorsのメソッドコンビネーションを眺めたり再現してみよう: :pass-on
Posted 2018-12-12 19:45:24 GMT
《 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の機能を実装しているものは無いように思えます。
SBCLは、ソースを眺める限り&restを処理できていないのですが、今後修正されれば、今回の:pass-onも動くんじゃないかなと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
Flavorsのメソッドコンビネーションを眺めたり再現してみよう: :daemon-with-override
Posted 2018-12-12 13:48:13 GMT
《 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
実践SETF定義: setf placeって多値が取れたり取れなかったりする?
Posted 2018-12-12 13:04:44 GMT
《 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ベースのマクロについての定義があります。
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を処理できても良いと思うのですが、何か事情があるのでしょうか。
これらのフォームは、ループ内で頻出しそうなので極力無駄のない定義になる必要があるような気はしますが、展開時に無駄は省けそうですし、さて真相やいかに……。
■
HTML generated by 3bmd in LispWorks 7.0.0
Flavorsのメソッドコンビネーションを眺めたり再現してみよう: その二
Posted 2018-12-11 14:47:02 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 11日目 》
前回に引き続き、メソッドコンビネーション元祖のFlavorsに標準装備されていたメソッドコンビネーションを眺めたり再現してみたりしようと思います。
前回いきなりcaseメソッドコンビネーションの再現に取り組んでみましたが、改めて、どんなメソッドコンビネーションがあるのか一覧にしてみたくなりました(ネタ切れだから)
調べてみたのは、後期Flavors〜New Flavorsあたりのメソッドコンビネーションです。
前知識
Flavorsのメソッドコンビネーションの標準構成は、Common Lisp版から:aroundを外したようなものです。
:aroundの部分は、defwrapperというメソッドを囲むマクロを定義する感じになります。
また、キーワードシンボルになっていますが、Lisp Machine Lispでは、userパッケージのシンボルの略記になります。
つまり、(eq :progn 'progn)です。
共用シンボルはuserパッケージに置かないで、keywordパッケージに纏めよう、と整理したのがCommon Lispです。
さて、では眺めてみましょう。
:daemon
Common Lispのstandardメソッドコンビネーションから:aroundを外したようなもの。
これを:darmonと呼びます。
:before / :after
Common Lispと同じです、:daemonメソッドコンビネーションの部品を単体で呼び出しているとも考えられます。
:and / :or / :progn
Common Lispから:aroundを外したようなもの。
:append / :nconc / :list
Common Lispから:aroundを外したようなもの。
:inverse-list
listが逆順になって返ってきます。
わざわざ用意しているからには使い道があるのでしょう……。
:max / :min / :sum
Common Lispと同じですが、:sumは、Common Lispでは+になっていますね。
:case
前回紹介した不思議メソッドコンビネーションです。
:daemon-with-and
:andの前後を:before、:afterで囲んだものです。
Common Lispではandに:daemonは付きません。
:daemon-with-or
:orの前後を:before、:afterで囲んだものです。
:daemon-with-override / :override
:overrideで定義したメソッドが:daemonメソッドコンビネーションの前に配置されていて、それがorで結合しています。
つまり、:overrideがnilを返した場合だけ、:daemonに進むという変ったものです。
:two-pass
プライマリ全部起動の後に:after全部を起動するものらしいです。
make-instanceで良く使うらしいですが、インスタンス初期値の設定とかでしょうか。
:pass-on
メソッドの返り値を次のメソッドに次々と渡していくメソッドコンビネーションのようです。
先日フィルターを作ろうとしていましたが、pass-onならできそうです。
しかし、返り値は何故か多値で返す様子。。
(a b c)という引数を持つメソッドを連鎖させるには、(values a b c)で値を渡さないといけないようですが、何故なのか。
ネタ切れなので、次回からCommon Lispで、Flavorsのメソッドコンビネーションを、`Symbolics Open Genera上のFlavorsの挙動を確認しつつ再現していきます。
■
HTML generated by 3bmd in LispWorks 7.0.0
実践SETF定義:define-setf-expanderで型破りなsetf構文を作ろう
Posted 2018-12-10 17:46:17 GMT
《 Lisp SETF Advent Calendar 2018 11日目 》
setf関数、defsetfと紹介してきましたが、今回は一番汎用的なdefine-setf-expanderの紹介です。
実際、defsetfや、define-modify-macroも、define-setf-expanderの定義に展開している処理系も多いです。
define-setf-expanderを簡単に説明すると、
(setf (x y z) a b c)のようなフォームのx、y、z、a、b、cという部品を好きなように配置することが可能です。
好きなように、といっても一応x、y、zは変数としての振舞い、a、b、cは値としての振舞いをする必要はありますので、作法に則る必要はあります。
CPLの代入構文のallを作ってみよう
左辺値について調べている際に、CPLが左辺値、右辺値を整理したとWikipediaに書いてあったので、ちょっと眺めてみましたが、Fortran、Algolに比較すれば、左辺値が拡張された感じはします。
左辺値にリスト表現や配列をとって、変数を複数同時に代入できたり、リストを分解して変数に代入できたり、1963年の言語にしては先進的ですが、拡張のバリエーションとして、
all a, b, c := 0という書法がありました。
上記の場合は、変数全部に0が代入されるわけですが、左辺と右辺で微妙に対称性がなく、イレギュラーなsetf定義の例に良さそうなので、ちょっと考えてみましょう。
まず、構文の見た目ですが、こんな感じになるかなと思います。
(setf (all a b c) 0)(list a b c)
→ (0 0 0)
構文全体としては直感的なのですが、allというゲッターを考えるに、これは単独では存在できそうにないですが、どうなんでしょう。
それはさておきこんな感じに書いてみました。
(define-setf-expander all (&rest places &environment env)
(loop :with store := (gensym "all-")
:for p :in places
:for (d v sv setter getter) := (multiple-value-list (get-setf-expansion p env))
:append d :into ds
:append v :into vs
:append sv :into svs
:collect setter :into setters
:collect getter :into getters
:finally (return
(values ds
vs
`(,store)
`(let (,@(mapcar (lambda (v)
`(,v ,store))
svs))
(values ,@setters))
`(values ,@getters)))))下記のフォームをマクロ展開してみると、
(let ((x 0)
(y 0)
(z 0))
(incf (all x y z) 100)
(list x y z))
→ (100 100 100)こんな感じになります。
(let ((x 0) (y 0) (z 0))
(let* ()
(let* ()
(let ((#:|all-128690| (+ (values x y z) 100)))
(let ((#:|Store-Var-128691| #:|all-128690|)
(#:|Store-Var-128692| #:|all-128690|)
(#:|Store-Var-128693| #:|all-128690|))
(values (setq x #:|Store-Var-128691|)
(setq y #:|Store-Var-128692|)
(setq z #:|Store-Var-128693|))))))
(list x y z))大体の場所でallは機能が成立するようです。
(let ((x (list 0 1 2))
(y 0)
(z 1))
(setf (all (values (car x) (cadr x)) y z)
42)
(list x y z))
→ ((42 42 2) 42 42) (let ((v (make-sequence 'vector 7)))
(setf (all (elt v 1)
(elt v 3)
(elt v 5))
'-
(all (elt v 0)
(elt v 2)
(elt v 4)
(elt v 6))
'+)
v)
→ #(+ - + - + - +)
しかし、push、popの挙動は良く分かりません。
push/popした後のリストがallによって同値になるので、これであってるような間違っているような。
(let ((x (list 1 2 3))
(y (list 0 0 0)))
(push 'a (all x y))
(list x y))
→ ((a 1 2 3) (a 1 2 3)) (let ((x (list 1 2 3))
(y (list 0 0 0)))
(pop (all x (cdr y)))
(list x y))
→ ((2 3) (0 2 3))
まとめ
変った代入構文をみつけたら、また定義に挑戦してみようと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
Flavorsのメソッドコンビネーションを再現してみよう: case篇
Posted 2018-12-09 20:59:45 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 10日目 》
組み込みのメソッドコンビネーションの紹介も尽きてきたので、メソッドコンビネーション元祖のFlavorsに標準装備されていたメソッドコンビネーションの再現でもしてみましょう。
Flavorsのcaseメソッドコンビネーション(の真似のつもり)
Flavorsのcaseメソッドコンビネーションと題しつつオリジナルの挙動が確認できていないのですが、どうもFlavorsとNew Flavorsで挙動が違うようです。
再現したつもりなのは、New Flavorsの方ですが、もしかすると、第二修飾子がメソッドの引数に現れた場合のディスパッチにcaseを使うのかもしれません。
作成してみたものは、メソッドの引数を安直にcaseに展開するもので、第二修飾子がcaseのマッチ対象になります。
(define-method-combination case ()
((case-clauses (case . *)))
(:arguments a)
(loop :for c :in case-clauses
:if (equal '(case otherwise) (method-qualifiers c))
:collect c :into otherwise
:else
:collect `(,(cadr (method-qualifiers c)) (call-method ,c nil)) :into clauses
:finally
(return
`(case ,a
,@clauses
,@(and otherwise
`((otherwise
,(reduce (lambda (m ms)
`(call-method ,m ,(and ms `((make-method ,ms)))))
otherwise
:initial-value nil
:from-end T))))))))(defgeneric fib (n)
(:method-combination case))(defmethod fib case 0 (n) n)
(defmethod fib case 1 (n) n)
(defmethod fib case otherwise ((n number))
(+ (fib (1- n)) (fib (- n 2))))
(defmethod fib case otherwise ((n integer))
(call-next-method))
(fib 20)
→ 6765
展開を確認してみるとこんな感じです
(mc-expand #'fib
'case
nil
20)
→
(case a
(1 (call-method #<standard-method fib (case 1) (t) 41E00640EB> nil))
(0 (call-method #<standard-method fib (case 0) (t) 41E00641C3> nil))
(otherwise
(call-method
#<standard-method fib (case otherwise) (integer) 41E0061D63>
((make-method
(call-method
#<standard-method fib (case otherwise) (number) 41E0059333>
nil)))))) eql特定子をメソッドコンビネーションで実装してしまっている感がありますが、汎用化を推し進めると、filtered-functionみたいなことになるのかなと思います。
今後、Flavors、New Flavorsのcaseメソッドコンビネーションの挙動が確認できたら、オリジナルに忠実なものも作成してみようと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
define-method-combinationの短形式は使えるか
Posted 2018-12-09 10:54:06 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 9日目 》
前回メソッドコンビネーションのlistが:aroundと組み合わせることで結構汎用的に使えることが分かってしまいました。
+、min、max、append、nconcのメソッドコンビネーションを眺めると、どれも&restな引数の関数なので、listメソッドコンビネーションでできた結果を:aroundでapplyすれば良いだけです。
define-method-combinationの短形式は指定したシンボルのフォームで囲むメソッドコンビネーションを定義しますが、関数以外のオペレーターも指定することが可能です。
define-method-combinationの短形式の存在意義を確認するため、clパッケージ内のフォームを物色してみました。
define-method-combinationの短形式で定義できそうなものを探す
ということで、引数が&restか&bodyかで始まるフォームをclパッケージから探してみましたが、下記のようになりました。
(ql:quickload :trivial-arguments)(loop :for s :being :the :external-symbols :of :cl
:when (and (fboundp s)
(ignore-errors
(typep (trivial-arguments:arglist s)
'(cons (member &rest &body) *))))
:collect s)
→
(rotatef shiftf cond ignore-errors
append logeqv tagbody and
locally logand lcm psetf
trace vector in-package with-standard-io-syntax
gcd psetq setq logior
nconc or list progn
make-broadcast-stream values untrace loop
make-concatenated-stream declaim logxor +
*)
なるほど、碌な応用が考えつかないものばかりです。
標準で提供されているメソッドコンビネーションは、このリストの中でも割合に有用なものが選ばれていたことも判ります。
とりあえず、幾つか定義を試してみましょう
ignore-errorsメソッドコンビネーション
define-method-combinationの短形式で順次実行のフォームを定義した場合、基本的にprognと同じようになります。
(define-method-combination ignore-errors)(defgeneric foo (x y)
(:method-combination ignore-errors))
(defmethod foo ignore-errors (x y)
(+ x y))
(defmethod foo ignore-errors ((x list) (y list))
(append x y))
(foo 1 2)
→ 3
(foo '(0 1 2) '(a b c))
→ nil
#<conditions:arithmetic-type-error 40201FF25B>
こんな感じに展開されるのですが、エラーが発生してもとにかく続行したいという時には使えるかもしれません。
ignore-errorsメソッドコンビネーションは、prognメソッドコンビネーションを`ignore-errorsで囲めば定義せずに済んでしまいそうです。
and、orメソッドコンビネーションと:aroundでignore-errors適用も良さそうです。
一応の展開形確認
(mc-expand #'foo
'ignore-errors
nil
'(0 1 2)
'(a b c))→
(ignore-errors (call-method
#<standard-method foo (ignore-errors) (list list) 402014EFD3>
nil)
(call-method
#<standard-method foo (ignore-errors) (t t) 40201FE2C3>
nil))
valuesメソッドコンビネーション
listメソッドコンビネーションに:aroundでvalues-listすれば良いのですが、より直截的でしょうか。
(define-method-combination values)(defgeneric foo (x y)
(:method-combination values))
(defmethod foo values (x y)
(list x y))
(defgeneric bar (x)
(:method-combination values))
(defmethod bar values ((x number))
(list x 'number))
(defmethod bar values ((x rational))
(list x 'rational))
(defmethod bar values ((x float))
(list x 'float))
(defmethod bar values ((x integer))
(list x 'integer))
(bar 1.0)
→ (1.0 float)
(1.0 number)
まあ、頭を捻れば応用例も見出せるかもしれません。
loopメソッドコンビネーション
loopで囲んでみましたが、メソッドコンビネーションスコープとループのスコープが微妙に噛み合いません。
長形式で工夫して定義するかMOPでメソッドコンビネーションの枠組み自体を書き換えるかしないと、あまり有用な定義はできなさそうです。
噛み合わない点ですが、loopのblockスコープが指定できない、等々です。
これもprognメソッドコンビネーションで、条件が成立するまでループさせるような:aroundを書いた方が有用かもしれません。
(define-method-combination loop)(defgeneric baz (x)
(:method-combination loop))
(defmethod baz loop (x)
(print x)
(throw 'baz x))
(defmethod baz loop ((x number))
(print (list (incf x) 'number)))
(defmethod baz loop ((x rational))
(print (list (incf x) 'rational)))
(defmethod baz loop ((x integer))
(print (list (incf x) 'integer)))
(defmethod baz :around (x)
(catch 'baz
(call-next-method)))
(baz 8)
▻ (9 integer)
▻ (9 rational)
▻ (9 number)
▻ 8
→ 8
tagbodyメソッドコンビネーション
折角なので常軌を逸していそうなtagbodyについて考えてみましたが、blockや、tagbodyのタグのスコープはダイナミックエクステントなので、普通に書いたらメソッドを跨ぐことができません。
ということで、定義がtagbodyやblockの中に収まっている必要があります。
(define-method-combination tagbody)(defgeneric fact (n)
(:method-combination tagbody))
(block nil
(let ((n 20)
(ans 1))
(tagbody
(defmethod fact tagbody ((n (eql 0)))
(go X))
(defmethod fact tagbody ((n integer))
(setq ans (* n ans))
(go L))
L (decf n)
(fact n)
X (return ans))))
→ 121645100408832000
まとめ
define-method-combinationの短形式を使って有用なものを定義できることは、ほぼなさそうです。
関数系であれば、listメソッドコンビネーション & :aroundの組み合わせで、順次実行フォーム系であれば、progn & :aroundの組み合わせを、非常に簡潔に書ける、ということがメリットですが、長形式だけ用意しておけば良かったのではないかナー、という結論です。
■
HTML generated by 3bmd in LispWorks 7.0.0
setf系アイデアの最終形態: letf
Posted 2018-12-08 19:29:08 GMT
《 Lisp SETF Advent Calendar 2018 9日目 》
今回は、また毛色を変えて、setf系の面白構文を紹介したいと思います。
letf
letfは、Lisp Machine Lispに存在したletとsetfが合体したような構文です。
束縛系構文なので、代入系のsetfとはちょっと違うのですが、こんな感じで使えます。
(defstruct s x y z)(let ((s (make-s :x 0 :y 1 :z 2)))
(letf (((s-x s) 42))
(print s)
(list s
(s-x s)
(s-y s)
(s-z s))))
▻ #S(s :x 42 :y 1 :z 2)
→ (#S(s :x 0 :y 1 :z 2)
42
1
2)
letの変数部分が、setfでいう一般化変数になっていて、上記の場合は、letfのボディの中では構造体sのxスロットは42になっていますが、スコープを抜ければ復帰します。
Lisp Machine Lispでは、ロカティブという参照の仕組みがありますが、ロカティブをすげかえる仕組みがマシンのメモリ参照のレベルで実装されていて、この機能によってCommon Lispでいうスペシャル変数のような感じで色々なものの参照を扱えるのですが、letfはこれを活用しています。
Common LispでもLispWorksのような一部の処理系には、letfがユーティリティとして含まれていますが、代入して元に戻すフォームをunwind-protectで囲んだ実装です。
Emacs Lispのcl.elにも何故かletfがありますが、こちらも代入して復帰となっています。
※註: Common Lispにはletfはありません。
なお、代入して元に戻す方式と、スペシャル変数のようなバインディング方式の違いですが、マルチプロセス時等に挙動が変ってきます。
また、letfで扱えるのは、ロカティブのみです。
setfでは読み出しと書き込みで整合性がなかったり非対称なものを定義できますが、こういうものはletfでは扱えません。
参考
■
HTML generated by 3bmd in LispWorks 7.0.0
定番メソッドコンビネーション紹介: list
Posted 2018-12-08 08:45:11 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 8日目 》
今回はCommon Lispの組み込みメソッドコンビネーションのlistを紹介していきます。
listメソッドコンビネーション
listは、メソッドの集合をlistで囲んだように実行するもので、全体の結果がリストとして返ってきます。
(defgeneric foo (x)
(:method-combination list))(defmethod foo list ((x number))
(cons x 'number))
(defmethod foo list ((x rational))
(cons x 'rational))
(defmethod foo list ((x float))
(cons x 'float))
(defmethod foo list ((x integer))
(cons x 'integer))
(foo 1)
→ ((1 integer) (1 rational) (1 number))
こんなのどこで使うんだと思ってしまいますが、あれこれ考える中で、返り値がリストということは、:aroundで色々変形してやれば、結構汎用的な使い方もできることに気付きました。
多値で返す
(defmethod foo :around (x)
(values-list (call-next-method)))(foo 1)
→ (1 integer)
(1 rational)
(1 number)
任意の集約
(defmethod foo :around (x)
(reduce (lambda (x ans)
`(,(+ (car x) (car ans))
,(cons (cadr x) (cadr ans))))
(call-next-method)
:initial-value '(0 nil)
:from-end T))(foo 1)
→ (3 (integer rational number))
標準の組み込みメソッドコンビネーションで結果を集約する関数系のものに、+、min、max、append、nconcがありますが、これ等は、list+:aroundで集約で実現できてしまいそうです。
自ら今後紹介するメソッドコンビネーションのネタを潰してしまった感もありますが、次回も、標準組み込みのメソッドコンビネーションを紹介したりしようかなと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
実践SETF定義: defsetf長形式篇
Posted 2018-12-07 18:38:26 GMT
《 Lisp SETF Advent Calendar 2018 8日目 》
実践編今回は、defsetfの長形式篇です。
前回、defsetfの短形式を紹介しましたが、短形式では、引数の順番等の条件がうまく嵌ればとても簡潔に書けます。
しかし、そうはいかない場合もあるのと、仮引数で&optional、&key等々と指定したい場合にdefsetfの長形式を使うことになります。
短形式と同じ例ですが、こんなゲッターとセッターの対があった場合、
(defun kar (list)
(car list))(defun set-kar (list val)
(rplaca list val))
(let ((u (list 0 1 2)))
(set-kar u 42)
(list u (kar u)))
→ ((42 1 2) 42)
(defsetf kar (list) (val)
`(set-kar ,list ,val))のように、普通のマクロ定義のような感じで書けます。
(let ((u (list 0 1 2)))
(setf (kar u) 42)
(list u (kar u)))
→ ((42 1 2) 42) 引数宣言の順番も、setfが使われる場合の引数の順番と同じなので迷うこともないでしょう。
短形式では、非常に簡潔に書けました、
(defsetf kar set-kar)しかし、長形式で明示的に書かれていた方が判り易いですね。
defsetfで定義できるものは基本的にセッターとゲッターが存在し、それが対称に動作しているものになります。
defsetfで扱えないようなイレギュラーなものは、最も汎用的なsetf定義オペレーターである、define-setf-expanderとget-setf-expansionを駆使することになります。
アドベントカレンダーの後半ではイレギュラーなsetf定義でも紹介していこうかなと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
定番メソッドコンビネーション紹介: progn
Posted 2018-12-06 17:46:30 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 7日目 》
今回はCommon Lispの組み込みメソッドコンビネーションのprognを紹介していきます。
prognメソッドコンビネーション
prognは、メソッドの集合をprognで囲んだように実行するものです。
メソッドコンビネーションアドベントカレンダー 5日目で、フィルターのパターンをメソッドコンビネーションですっきり書けないか考えていましたが、アイテムの一時置き場を用意して更新していくことが可能であれば、prognで書けそうだと思ったので試してみました。
メニューにはアイテム置き場とフィルター適用済アイテムを持たせて、初期化とソートを:aroundで、他各種フィルターの適用は、prognメソッドコンビネーションで実行してみています。
(defclass menu ()
((items :initform '() :initarg :items :accessor items)
(filtered-items :initform '() :initarg :items :accessor filtered-items)))(defclass fizz-filtered-menu (menu) ())
(defclass buzz-filtered-menu (menu) ())
(defclass *-filtered-menu (fizz-filtered-menu buzz-filtered-menu) ())
(defgeneric filter (menu)
(:method-combination progn))
(defmethod filter :around ((menu *-filtered-menu))
(setf (filtered-items menu) ;filtered-items初期化
(items menu))
(call-next-method) ;フィルタリング
(setf (filtered-items menu) ;昇順にソート
(sort (filtered-items menu) #'<))
menu)
(defmethod filter progn ((menu fizz-filtered-menu))
(setf (filtered-items menu)
(remove-if-not (lambda (x) (zerop (mod x 3)))
(filtered-items menu)))
menu)
(defmethod filter progn ((menu buzz-filtered-menu))
(setf (filtered-items menu)
(remove-if-not (lambda (x) (zerop (mod x 5)))
(filtered-items menu)))
menu)
フィルターを掛けるためだけに、mixin的なクラスを定義するのが、微妙な気がしますが、まあ良しとしましょう。
実行してみましょう。
(let ((menu (make-instance '*-filtered-menu
:items (loop :repeat 100 :collect (random 100)))))
(filtered-items (filter menu)))
→ (0 15 30 45 45 60 60 60 75) 先日定義してみたmc-expandで展開形を確認してみると、:aroundで囲まれたprognということが判ります。
(mc-expand #'filter 'progn nil (make-instance '*-filtered-menu))
→
(call-method
#<standard-method filter (:around) (*-filtered-menu) 41C008E0CB>
((make-method
(progn
(call-method #<standard-method filter (progn) (fizz-filtered-menu) 402003E7FB> nil)
(call-method #<standard-method filter (progn) (buzz-filtered-menu) 4020052C8B> nil))))) :around修飾子の謎 その二
:aroundは、メソッド単体を囲んで実行するというよりは、コンビネーション全体を取り囲うものなのでは? Flavorsのdefwrapperのような使い方をするのではないか? と昨日書きましたが、改めてSonya Keene氏 のObject-Oriented Programming in Common Lisp(邦訳:Common Lispオブジェクト指向)を確認したところ、「5. Controlling the Generic Dispatch」の章でちゃんとそんな風に説明してました。
前に読んでた筈でしたが、すっかり忘れていたようです……。
Object-Oriented Programming in Common Lisp(邦訳:Common Lispオブジェクト指向)は、Common Lispにオブジェクトシステムを導入するのにあたって貢献した人達(主にSymbolics)が執筆に協力している本なので、割合に説明が細かいです。
また、多くの書籍では、Common Lispと他の言語のオブジェクトシステムとの対比でオブジェクトシステムに変な機能があるとか無いとかで説明されることも多いですが、この本は、Common Lispネイティブな視点で書かれている所もお勧めです(ANSI CL成立前の仕様だったりするのが若干残念)
次回も、標準組み込みのメソッドコンビネーションを紹介したりしようかなと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
定番メソッドコンビネーション紹介: and
Posted 2018-12-05 18:10:00 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 6日目 》
今回はCommon Lispの組み込みメソッドコンビネーションのandを紹介していきます。
andメソッドコンビネーション
standardはパターンに分類するなら呼び出しのフックの実現でしたが、andは、メソッドの集合をandで実行するものです。
二次元座標2dと、それを継承した3d、ついでに何故か2dのスーパークラスである1dがある場合を考えてみましょう。
(defclass 1d ()
((x :initarg :x :accessor x)))(defclass 2d (1d)
((y :initarg :y :accessor y)))
(defclass 3d (2d)
((z :initarg :z :accessor z)))
これらの等価を判定する==を考えてみると、andを使えば、
(defgeneric == (x y)
(:method-combination and))(defmethod == and ((a 1d) (b 1d))
(= (x a) (x b)))
(defmethod == and ((a 2d) (b 2d))
(= (y a) (y b)))
(defmethod == and ((a 3d) (b 3d))
(= (z a) (z b)))
こんな風にすっきり書けます。
(== (make-instance '1d :x 10)
(make-instance '1d :x 10))
→ t (== (make-instance '2d :x 10 :y 20)
(make-instance '2d :x 10 :y 25))
→ nil
(== (make-instance '3d :x 100 :y 50 :z 80)
(make-instance '3d :x 100 :y 50 :z 80))
→ t
(== (make-instance '3d :x 100 :y 50 :z 80)
(make-instance '3d :x 100 :y 50 :z 8))
→ nil
前回定義してみたmc-expandで展開形を確認してみると、こんな感じに、実際にandでメソッドが囲まれています。
※なお展開形は実装依存です。LispWorksでは実際は、sys::blocked-andが使われています。
(mc-expand #'==
'and
nil
(make-instance '3d :x 100 :y 50 :z 80)
(make-instance '3d :x 100 :y 50 :z 8))
→
(and (call-method #<standard-method == (and) (3d 3d) 41D052D4A3>
nil)
(call-method #<standard-method == (and) (2d 2d) 41D052D48B>
nil)
(call-method #<standard-method == (and) (1d 1d) 41D04E5EE3>
nil))さらに、andは、:around修飾子も持っているので、実行の全体を何かの処理で包みたい場合に使えます。
(defvar *debug* nil)(defgeneric == (x y)
(:method-combination and))
(defmethod == and ((a 1d) (b 1d))
(when *debug* (print (list (x a) (x b))))
(= (x a) (x b)))
(defmethod == and ((a 2d) (b 2d))
(when *debug* (print (list (y a) (y b))))
(= (y a) (y b)))
(defmethod == and ((a 3d) (b 3d))
(when *debug* (print (list (z a) (z b))))
(= (z a) (z b)))
(defmethod == :around (x y)
(let ((*debug* T))
(call-next-method)))
(== (make-instance '3d :x 100 :y 50 :z 80)
(make-instance '3d :x 1 :y 50 :z 80))
▻ (80 80)
▻ (50 50)
▻ (100 1)
→ nil
:around修飾子の謎
メソッドコンビネーションアドベントカレンダーを書き始める前は、and等でも:aroundが使えるのを知りませんでした。
使えることを知ってからも一体何に使うのか謎でしたが、Flavorsにあった、defwrapperのようなパターンを記述するためなのかもしれません。
そう考えると:aroundが最外周に配置されることもなんとなく分かる気がしますが、
上記の例は、ちょっとわざとらしい例ながらもdefwrapperの使い方に近いです。
次回も、標準組み込みのメソッドコンビネーションを紹介したりしようかなと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
実践SETF定義: defsetf短形式篇
Posted 2018-12-05 16:45:28 GMT
《 Lisp SETF Advent Calendar 2018 6日目 》
実践編今回は、defsetfの短形式篇です。ネタは刻んでいきます。
defsetfや、define-method-combinationでは、良く使いそうなものを短く書ける短形式と、詳細にパラメータを記述できる長形式がありますが、そんなに頻繁に使うわけでもないので、短形式があることで逆に混乱を招いている気がします……。
そんな短形式ですが、既存のゲッターとセッターが違う名前で存在する場合に、ゲッターの名前に統一するような場合に使えます。
具体例としては、こんな対があった場合、
(defun kar (list)
(car list))(defun set-kar (list val)
(rplaca list val))
(let ((u (list 0 1 2)))
(set-kar u 42)
(list u (kar u)))
→ ((42 1 2) 42)
defsetf一発で(setf kar)に纏められます。
(defsetf kar set-kar)しかし、セッター側の引数の順番に注意。
うまくはまるには、変数→値の順である必要があります。
(let ((u (list 0 1 2)))
(setf (kar u) 42)
(list u (kar u)))
→ ((42 1 2) 42) 処理系の基本関数などの定義では、結構使われているようですが、ユーザーが書くプログラムで、バラバラの名前のゲッター、セッターをsetfのもとに統一する、ということはあまりなさそうです。
長形式だけを用意しておいて、パターンが頻出する場合には、ユーザにマクロを書かせる、という方針でも良かったのでは……。
次回は、defsetfの長形式を解説してみます。
■
HTML generated by 3bmd in LispWorks 7.0.0
カジュアルにメソッドコンビネーション定義してみよう
Posted 2018-12-05 07:11:18 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 5日目 》
組み込みのメソッドコンビネーションのパターンを淡々と紹介していこうかなと思いましたが、eshamsterさんの記事が面白かったので、自分も簡単なものを考えて定義してみることにしました。
フィルターでメソッドコンビネーションが使えないか
たまたま今日GUIの一覧メニューのフィルターを作成していて、フィルターってメソッドコンビネーションで上手く書けるのでは?と思ったので試してみます。
とりあえず、リスト対して絞り込みの関数を順にandな感じで適用していく、という感じです。
通常なら、下記のようにでも書くのかなという所です。
(flet ((filter-integerp (list)
(remove-if-not #'integerp list))
(filter-evenp (list)
(remove-if-not #'evenp list))
(filter-flatten (list)
(flatten list)))
(defparameter *fns* (list #'filter-flatten
#'filter-integerp
#'filter-evenp)))(reduce (lambda (res f)
(funcall f res))
*fns*
:initial-value
'((1 2 3 4 (1 2 3 4 nil t 8) t 8) (1 2 3 4 (1 2 3 4 nil t 8) t 8)))
→ (2 4 2 4 8 8 2 4 2 4 8 8)
フィルターをメソッドコンビネーションで書いてみよう
下準備
メソッドコンビネーションを定義するにあたって、コンビネーションがどう展開されるかを確認しつつ書きたいので展開ユーティリティを定義すると良いかなと思います。
(ql:quickload :closer-mop)(defun mc-expand (gf mc mcopts &rest args)
(c2mop:compute-effective-method gf
(c2mop:find-method-combination gf mc mcopts)
(compute-applicable-methods gf args)))
これでこんな感じに展開できます。
(mc-expand #'foo
'chain
'()
'(1 2 3 4 nil t 8))
→
(progn
(call-method
#<standard-method foo (chain evenp-filter) (list) 4020328873>
((make-method
(call-method
#<standard-method foo (chain integerp-filter) (list) 4020231D53>
nil))))) 展開を確認しながら書けるのであれば、謎のdefine-method-combinationも使いこなせる気がしてきます。
書いてみる
さて、とりあえずは、フィルター適用の順序不定で良しとして、こんな感じに書いてみました。
標準のメソッドコンビネーションでは、:before、:after等、修飾子の指定は一つですが、実際はこの部分はリストになっていて、equalで等価判定されます。
定義されるメソッドが違う名前であれば、クラス関係に関係なく増やすことが可能です。
(define-method-combination chain ()
((methods (chain . *)))
`(progn
,(reduce (lambda (m ms)
`(call-method ,m ,(and ms `((make-method ,ms)))))
methods
:initial-value nil
:from-end T)))(defgeneric foo (x)
(:method-combination chain))
(defmethod foo chain integerp-filter ((u list))
(remove-if-not #'integerp (call-next-method)))
(defmethod foo chain evenp-filter ((u list))
(remove-if-not #'evenp (call-next-method)))
(defmethod no-next-method ((gf (eql #'foo)) method &rest args)
(apply #'identity args))
(foo '(1 2 3 4 nil t 8))
→ (2 4 8) call-next-methodで次を呼ばないといけないのがめんどうな気がしますが、処理結果を次に渡す安直で良い方法が分かりません(メソッドを分解して関数を取り出しても良いのですが……)
順不同で登録/呼びだしをするのでno-next-methodでデフォルト値を返すようにしています。
やっぱり順番を指定したい
やっぱり適用順によってはエラーになるようなフィルター構成もあるので、順番は指定しても良いかなと思ったので、優先順位を指定してみることにしました。
(defun ordered-chain-qualifier-p (method-qualifiers)
(typep method-qualifiers
'(cons (eql ordered-chain) (cons integer (cons T null)))))(define-method-combination ordered-chain ()
((methods ordered-chain-qualifier-p))
(let ((methods (remove-duplicates methods
:key (lambda (method)
(third (method-qualifiers method)))
:from-end T)))
`(progn
,(reduce (lambda (m ms)
`(call-method ,m ,(and ms `((make-method ,ms)))))
(stable-sort methods #'>
:key (lambda (method)
(second (method-qualifiers method))))
:initial-value nil
:from-end T))))
(defgeneric bar (x)
(:method-combination ordered-chain)))
(defmethod bar ordered-chain 0 identity ((u list))
u)
(defmethod bar ordered-chain 100 integerp-filter ((u list))
(remove-if-not #'integerp (call-next-method)))
(defmethod bar ordered-chain 200 evenp-filter ((u list))
(remove-if-not #'evenp (call-next-method)))
(defmethod bar ordered-chain 1 flatten-filter ((u list))
(flatten (call-next-method)))
展開はこんな感じです。
(mc-expand #'bar
'ordered-chain
'()
'(1 2 3 4 nil t 8))
→
(progn
(call-method
#<standard-method bar (ordered-chain 200 evenp-filter) (list) 4020447F83>
((make-method
(call-method
#<standard-method bar (ordered-chain
100
integerp-filter) (list) 402031D65B>
((make-method
(call-method
#<standard-method bar (ordered-chain
1
flatten-filter) (list) 4020458C5B>
((make-method
(call-method
#<standard-method bar (ordered-chain 0 identity) (list) 4020467533>
nil)))))))))))メソッドコンビネーション修飾子の二番目に整数で優先度を付けてみました。
パターンマッチでも行けると思いますが、ordered-chain-qualifier-pを定義して選別しています。
メソッドコンビネーション修飾子はequalで判定されると上述しましたが、優先度を変更して再定義するとメソッドがどんどん増えてしまうので、重複も削除しています。
また、デフォルトメソッドを最優先として定義すればno-next-methodの定義も不要になります。
さて実行してみると、
(bar '((1 2 3 4 (1 2 3 4 nil t 8) t 8) (1 2 3 4 (1 2 3 4 nil t 8) t 8)))
→ (2 4 2 4 8 8 2 4 2 4 8 8) とりあえずは、3つのフィルターが順に適用されているようです。
問題点
しかし、優先度を付けてみると、今度は、call-next-methodと優先番号の組み合わせが直感的でない気がします。
具体的には、優先番号が低い順から呼ばれるのに、引数の適用は優先度の高い方からされる、ということで、call-next-methodで呼ばない場合、連鎖は優先度が低い方から途切れてしまいます。
call-methodの入れ子にしないで、平坦に優先順に並べ、適用結果を次々に受け渡すことができれば、整合性は取れる筈ですが……。
メソッドコンビネーションアドベントカレンダー終了まで良い解決策が思い付けば記事のネタにしたいと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
TAOの!
Posted 2018-12-04 17:31:40 GMT
《 Lisp SETF Advent Calendar 2018 5日目 》
今回は、TAO/ELISの!、!!についてです。
実の所、TAO/ELISの!、!!は、setfとは挙動は似ているものの実現方法が異なったもので、Common Lispのようにマクロに展開されるものではなく、(!という特別な括弧が作る代入フォームです。
詳しくは、1986年のbit誌のマルチパラダイム言語 TAO 連載で解説されていますので興味のある方は参照してみると良いかと思います。
この!記法は、setfが!になった感じですが、上述のように特殊な括弧です。
(!(car x) 42) ≡ (setf (car x) 42) このフォームは読み書きの場所を返すようになっている(マシンの支援あり)ので、
(!(if pred (car x) x) 42)のようなものもsetfのような事前のマクロ定義なしに書くことが可能です。
!!の方は自己代入式といって、これも面白くて便利なのですが、フォームの結果を代入する場所を!で指定して書き込むというものです。
これを使うと(setq x (+ x 42))のような良くある代入が、
(!!+ !x 42)のように書けます。
(!!cdr !x) ≡ (pop x)(!!nconc !(car x) y) ≡ (setf (car x) (nconc (car x) y))
(!!delete 'a !x) ≡ (setq x (delete 'a x))
等々入り組んだ表現になる程シンプルに書けたりします。
ちなみに、このアイデアは、1979のTAO/60にはあったようで、PDP-11上に実装された初期のTAO/60について書かれた、TAO LISP についての5. 複値形式 (Double valued form)の段落で説明があります。
これによると、
複値形式の概念に思い至ったのは, ALGOL68 や Pascal のプログラムを Lisp に移し替えようとしたとき, どうしてもスムーズにいかなかった悔しい経験があったからである.
とのことなので、やはりAlgol系言語の左辺値の書法が念頭にあったようです。
記法は、TAO/ELISの!ではなく、:を使っています。
TAO/ELISでは、Common Lispに接近したため、キーワードシンボルと記法がぶつかってしまうために!になったようです。
(TAO/ELIS復活祭(2010)で竹内先生が軽く説明していました)
インタプリタの軽快な動作に力を入れていたTAO/ELISでしたが、setfのようにコンパイル前提のマクロでの実現ではない方向で工夫を凝らした代入機構の紹介でした。
ちなみにCommon Lispでも、リーダーマクロで(を再定義すれば、そこそこ似た感じに記述することは可能です。
興味のある方は挑戦されてみてはいかがでしょうか。
■
HTML generated by 3bmd in LispWorks 7.0.0
実践SETF定義: #'(setf foo)篇
Posted 2018-12-03 16:50:53 GMT
《 Lisp SETF Advent Calendar 2018 4日目 》
どうもsetf機構についてどんどんマイナーな方向に進んでしまいそうなので、実践的なものも挟んでいきたいと思います。
Common Lispでのsetfの定義方法と定義構文ですが、やたらと数が多いです。
しかも、省略形式と、詳細形式に分かれていたりして、一体何を使ったら良いのかと思うこともままあります。
ざっと一覧にすると、
- 自動アクセサ生成系(
defclass、defstruct) - Macro Forms as Places/Symbol Macros as Places で自動で定義される系
(defun/defmethod (setf ...))defsetfdefine-setf-expanderdefine-modify-macro
加えて、定義時に使う補助関数として、get-setf-expansionがあります。
今回は、上記から、(defun/defmethod (setf ...)) を解説したいと思います。
(defun/defmethod (setf ...))
(defun/defmethod (setf ...)) の形式は、CLtL1には存在しておらず、ANSI CLになってから追加されたものです。
追加の目的ですが、メソッドのアクセサをdefmethodで定義させたいためです。
(defclass foo ()
(a b c))(defmethod (setf foo-a) (val (obj foo))
(setf (slot-value obj 'a) val))
こんな感じのことがしたいという訳ですが、ANSI CLでは、この為に関数名を拡張して、(setf foo)というような名前も使えるようにしました。
なお、この形式の関数名はsymbol-functionでは扱えないのでfdefinitionを利用します。(専らfdefinitionを使っておけば良いのですが)
(funcall #'(setf foo-a) 42 (make-instance 'foo))
→ 42(setf (foo-a (make-instance 'foo)) 42)
→ 42
(fdefinition '(setf foo-a))
→ #<standard-generic-function (setf foo-a) 40E01CBF4C>
単なる関数/メソッドなので、setfとは関係ないこともできてしまいますが、当然ながら、これはスタイル上良くないこと、とされています。
(defun (setf foo) (val var)
(list var val))(setf (foo 'var) 'val)
→ (var val)
なお、処理系が標準関数のsetfの実装をマクロにするか関数にするかは任意なので、関数で書けるからといって、
(funcall #'(setf car)...)のような書き方をしても可搬性は期待できません。
個人的には良くやってしまうミスなのですが、統一して欲しい……。
アドベントカレンダーもまだまだ残りの日数がありますので、今後もsetfの定義のバリエーションについて書いていきます。
■
HTML generated by 3bmd in LispWorks 7.0.0
史上初のSETFを探す旅
Posted 2018-12-02 18:25:23 GMT
《 Lisp SETF Advent Calendar 2018 3日目 》
探す旅とか書いてますが、LispでSETFのようなものが初めて導入されたのは、結論からいうとLISP 2(1965)だと思います。
しかし、Lispの歴史の文献については、The Evolution of Lispが決定版で良く知られているものなのですが、LISP 2についての記述は何故か殆どありません。
EoLに拠り所にするならば、1973年のL Peter Deutsch氏のByte Lisp(setfq)が最初となるでしょう。
さて、LISP 2ですが、LISP 2は、後世のLispの試行錯誤を先取りしている所が多々ありますが、それはAlgolとの接近による所が多いです。
その後のLispがAlgol化していったから、とも言えますが、具体的には、
- Algol構文の採用(Algolとコード共用できるレベルを目指す)
- 型宣言の導入
- 静的スコープの採用
- 拡張された左辺値
あたりがあります。
1975年にSchemeがAlgolの影響でLispに静的スコープを取り入れたのが、Lisp史の一つの大きな転換点とされますが、Schemeに10年先行して、LISPをまんまAlgol化しようとしたLISP 2が完全に忘却されているのは不思議ではあります。
なお、LISP 2の発掘については、Paul McJones先生が熱心に取り組まれているようです。
LISP 2は構想のみで実装はなかった、とされていましたが、先日実装も発見されたようです。後世で発掘されるというのも面白い。
さて、この記事ではsetfがメインテーマなので、上記3項目の中では、拡張された左辺値について詳しくみて行くのですが、setf関連については、
LISP II Internal Language(1965) 3.1 ASSIGNMENT-EXPRESSION, LOCATIVES に纏められています。
これによると、(SET locative expression)という形式になっていて、locativeというのがCommon Lispのsetfでいうplaceという感じになっています。
locativeには、ビットやリスト、配列があり、下記のように書けたようです。
(set (car x) b)(set (cdr x) b)
(set (bit 2 2 a) (bit 2 2 15))
(block ((a real array) (m integer))
(set (a m) 42))
(set (prop (quote x)) (quote (p 42)))
S式は中間言語なので、表層言語でも書いてみると、
car x ← b;cdr x ← b;
bit (2, 2, a) ← bit (2, 2, 15);
begin real array a; integer m;
a[m] ← 42;
end;
prop 'x ← '(p 42);
となります。
これらは、Common Lispで書くと、それぞれ、
(setf (car x) b)(setf (cdr x) b)
(setf (ldb (byte 2 2) a) (ldb (byte 2 2) 15))
(setf (aref a m) 42)
(setf (symbol-plist 'x) '(p 42))
となります。
LISP 2では型宣言するので、配列のsetでは、(配列名 インデックス)という形式でOKのようです。
読み出しと書き込みの記法の二重性について
左辺値について、1960年代初頭のFORTRAN、Algol、CPLあたりの扱いを眺めてみましたが、左辺に配列の記法が来るものは、添字付き変数という概念のようで、配列のアクセサが介在するものではないようです。
LISP 2の記法でもその辺りを踏襲しているように見えますが、locativeという概念で左辺にアクセサの記法が出てくるのは、当時の他の言語と比べてもそれなりに先進的だったのかもしれません。
参考
■
HTML generated by 3bmd in LispWorks 7.0.0
定番メソッドコンビネーション紹介: standard
Posted 2018-12-01 20:40:27 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 2日目 》
ほぼ無計画なので、内容が続き物だったりそうではなかったりします。
とりあえず、定番というか、Common Lispに標準で用意されているメソッドコンビネーションの紹介でもしていこうかなと思います。
standardメソッドコンビネーション
Common Lispのdefmethodで定義したものは、標準でこのタイプになります。
主な登場人物は、:before、:after、:around、call-next-methodです。
:before、:after、:aroundは、指定したコンビネーションでのメソッドの追加で利用し、call-next-methodは、優先順位リストに従って次のメソッドを起動します。
他のOOP言語では、superに相当しますが、Common Lispでは、必ずしも継承順位で上位ものを呼び出すわけではないので、call-nextなのでしょう。
とりあえず、実際に:before、:after、:around、call-next-method全部盛りのメソッドを定義して動作を確認してみましょう。
(progn
(defclass c1 () ())
(defclass c2 (c1) ())
(defclass c3 (c2) ()))(progn
(defmethod foo ((o c1))
(format T "~16T~A~%" '(foo c1)))
(defmethod foo ((o c2))
(format T "~16T~A~%" '(foo c2))
(call-next-method))
(defmethod foo ((o c3))
(format T "~16T~A~%" '(foo c3))
(call-next-method))
;;
(defmethod foo :before ((o c1))
(format T "~8T~A~%" '(foo c1 :before)))
(defmethod foo :before ((o c2))
(format T "~8T~A~%" '(foo c2 :before)))
(defmethod foo :before ((o c3))
(format T "~8T~A~%" '(foo c3 :before)))
;;
(defmethod foo :after ((o c1))
(format T "~24T~A~%" '(foo c1 :after)))
(defmethod foo :after ((o c2))
(format T "~24T~A~%" '(foo c2 :after)))
(defmethod foo :after ((o c3))
(format T "~24T~A~%" '(foo c3 :after)))
;;
(defmethod foo :around ((o c1))
(format T "~A~%" '(foo c1 :around))
(call-next-method))
(defmethod foo :around ((o c2))
(format T "~A~%" '(foo c2 :around))
(call-next-method))
(defmethod foo :around ((o c3))
(format T "~A~%" '(foo c3 :around))
(call-next-method)))
とりあえず、実行してみるとこんな感じになります。
(foo (make-instance 'c3))
▻ (foo c3 around)
▻ (foo c2 around)
▻ (foo c1 around)
▻ (foo c3 before)
▻ (foo c2 before)
▻ (foo c1 before)
▻ (foo c3)
▻ (foo c2)
▻ (foo c1)
▻ (foo c1 after)
▻ (foo c2 after)
▻ (foo c3 after)
→ nil大元のメソッドは、プライマリメソッドと呼びますが、call-next-methodで次のメソッドを呼ぶことが可能です。
上記では、(foo c3)、(foo c2)で明示的に呼び出していますが、もちろん無ければ呼ばれません。
:beforeは、プライマリメソッド起動の前に起動されますが、クラス優先順位リストの順に該当するものは全て呼び出されます。
:afterは、:beforeと対称の動作です。
なお、:before、:afterの中では、call-next-methodは使用できません。
:aroundが割合に複雑ですが、:aroundがあれば、それが最初に起動されます。
その:aroundの中で、call-next-methodが起動されれば、クラス優先順位リスト順に、次の:aroundを起動、:aroundがなければプライマリメソッドを起動します。
call-next-methodを呼べば、その返り値が利用できるので、このデフォルト値を加工するような使い方が殆どです。
:before、:afterではcall-next-methodが使えないので、スロットの値を設定する等、副作用目的での利用となります。
GoFのObserverパターンのようなものは、呼び出しイベント時に起動したいフックのようなものが多いので、:before、:afterで賄うことが可能かなと思います。
メソッドの中身を覗いてみる
compute-effective-methodで確認すると、call-methodの連鎖が直接見えて判り易いので確認してみると下記のようになります。
call-methodは第一引数に起動するメソッド、第二引数にそれ以降で起動するメソッドのリストを取りますが、入れ子にしていけば、所謂、継続渡しに似た記述になります。
起動リストが空か、メソッドのボディにcall-next-methodの記述がなければ、以降のメソッドは起動されず、そこで処理はストップします。
(c2mop:compute-effective-method #'foo
(c2mop:find-method-combination #'foo 'standard nil)
(compute-applicable-methods #'foo (list (make-instance 'c3))))→ (call-method
#<standard-method foo (:around) (c3) 4190211F13>
(#<standard-method foo (:around) (c2) 4190211F2B>
#<standard-method foo (:around) (c1) 4190211C93>
(make-method
(progn
(call-method #<standard-method foo (:before) (c3) 419021266B> '())
(call-method #<standard-method foo (:before) (c2) 4190212683> '())
(call-method #<standard-method foo (:before) (c1) 419021258B> '())
(multiple-value-prog1
(call-method
#<standard-method foo nil (c3) 4190212753>
(#<standard-method foo nil (c2) 419021276B>
#<standard-method foo nil (c1) 419021269B>))
(call-method #<standard-method foo (:after) (c1) 4190211F43> '())
(call-method #<standard-method foo (:after) (c2) 4190212573> '())
(call-method #<standard-method foo (:after) (c3) 419021255B> '()))))))
元祖Flavorsのデフォルトコンビネーション
元祖Flavorsでは、当初デフォルトのメソッドコンビネーションとして、:daemonコンビネーションが用意されていましたが、登場したのは大体1981年頃のようです。
これは、:before、プライマリ、:afterの組み合わせで、Common Lispのstandardからcall-next-methodと:aroundを削ったような挙動ですが、1984年あたりになると、:aroundも追加された様子。
call-next-methodのようなものはなく、#'(:method flavor method-name)のような形式で直接呼び出したり、:around専用の継続メソッドを呼び出す構文を使ったようです。
次回は、andコンビネーションあたりを紹介しようと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
メソッドコンビネーションってなに?
Posted 2018-12-01 09:50:35 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 1日目 》
Lisp メソッドコンビネーション Advent Calendar 2018始まりました。
開始初日にして既につらい。
setfネタともう一品と思ってテーマにメソッドコンビネーションを選んでみましたが、setf以上にニッチでした。
メソッドコンビネーションってなに?
さて、メソッドコンビネーションについての説明ですが、読んでそのまま、メソッドのコンビネーションのことです。
どういう面の組み合わせかというと、ざっくりメソッドの起動とその順番についてと考えて良いでしょう。
(defclass k0 () ())
(defclass k1 (k0) ())
(defclass k2 (k1) ())(defmethod m ((obj k2)) 'k2)
(defmethod m ((obj k1)) 'k1)
(defmethod m ((obj k0)) 'k0)
こんな感じの定義があったとすると、
Common Lispでは、compute-applicable-methodsで起動するメソッドを確認することが可能です。
(compute-applicable-methods #'m (list (make-instance 'k2)))(#<standard-method m nil (k2) 40E011D08B>
#<standard-method m nil (k1) 40E004A153>
#<standard-method m nil (k0) 40E006B64B>)
上記の定義では、k0 < k1 < k2 という継承順のクラスに対し、それぞれmを定義しています。
k2についてmを起動してみると、
(m (make-instance 'k2))
→ k2 となりますが、Common Lispの標準では、compute-applicable-methodsで求めたリストのメソッドが呼ばれていきます。
この例では他2つのメソッドは、呼ばれませんが、明示的な操作と相対的な名前で呼ぶことも可能です。
3つのメソッドのコンビネーションについて説明しましたが、Common Lispでは上記はstandardという名前が付いています。
なんとなく想像が付くかと思いますが、Common Lispでは任意のメソッドの束を任意の構成で呼んだり呼ばなかったりが可能です。
Advice機構とメソッドコンビネーション
メソッドコンビネーションというとbefore、after等の修飾子を付けてフックを掛ける使い方の印象が強いと思います。
具体的な例でいうと、上記のコードにbefore、afterを追加定義してmを起動すると、
(defmethod m :before ((obj k2)) (print "before k2"))
(defmethod m :after ((obj k2)) (print "after k2"))(m (make-instance 'k2))
▻ "before k2"
▻ "after k2"
→ k2となります。
さて、compute-applicable-methodsで確認してみると、メソッドが増えているのが分かります。
(compute-applicable-methods #'m (list (make-instance 'k2)))
→ (#<standard-method m (:after) (k2) 40E0868EF3>
#<standard-method m (:before) (k2) 40E086956B>
#<standard-method m nil (k2) 40E011D08B>
#<standard-method m nil (k1) 40E004A153>
#<standard-method m nil (k0) 40E006B64B>)起動のされ方については、Common LispのMOPで定義されているcompute-effective-methodで起動コードを確認することが可能です。
(c2mop:compute-effective-method #'m
(c2mop:find-method-combination #'m 'standard nil)
(compute-applicable-methods #'m (list (make-instance 'k2))))
→ (progn
(call-method #<standard-method m (:before) (k2) 40204EB4DB> nil)
(multiple-value-prog1
(call-method #<standard-method m nil (k2) 40E011D08B>
(#<standard-method m nil (k1) 40E004A153>
#<standard-method m nil (k0) 40E006B64B>))
(call-method #<standard-method m (:after) (k2) 40204E84E3> nil))) 上記はLispWorksの例ですが、起動するコードを直接確認できるので、何か良く分からなくなってきたら実際にどんなものが生成されるか確認してみるのも良いでしょう。
このように生成されたコードを眺めてみると、メソッドコンビネーションのコンビネーションの一つとして、フック/Advice機構が実現されていることが分かります。
本体メソッドの前後に副メソッドを配置するコンビネーションは、GoFデザインパターンでもObserverパターンとして良く知られていますが、古えのLisp畑(Flavors等)では、フレーム理論の影響からか、配置されるメソッドをdaemonと呼び、この標準パターンもdaemonと呼んでいます(ややこしい)
伝統を受け継いでいるCommon Lispでもこのコンビネーションが標準となっていて、standardという名前が付いている、という訳です。
フレームワークの代表的な使われ方と、フレームワークそのものが混同されるのは常ですが、メソッドコンビネーションもフックとしての使われ方だけではないことに留意する必要はあるでしょう。
今後は、メソッドコンビネーションの歴史、Common Lispや、Lisp Machine Lisp等でのメソッドコンビネーションの定義方法の解説etcを書いていく予定です(一体書けるのか)
■
HTML generated by 3bmd in LispWorks 7.0.0
SETFってなに?
Posted 2018-11-30 17:05:36 GMT
《 Lisp SETF Advent Calendar 2018 1日目 》
Lisp SETF Advent Calendar始まりました。
数年に一度Lisp系でニッチなAdvent Calendarを催したりしていますが、最近あまりニッチなことはしていませんでした。
その反動なのかLisp SETF Advent Calendarですが、ニッチすぎたかもしれません。
ちなみに、過去のニッチなAdvent Calendarには下記のようなものがあります。
- Lisp Reader Macro Advent Calendar 2012
- Metaobject Protocol(MOP) Advent Calendar 2013
- レトロLisp Advent Calendar 2016
SETFってなに?
さて、setfについての簡単な説明です。
プログラミング言語の代入構文にも様々ありますが、左辺に変数名だけでなく、配列の場所であったり、リストであったりが記述できるものがあります。
x := x + 1
a[x] := y + 1
a, b, c := list(0, 1, 2)
...右側にはどんな値でも置けるのですが、左側に置いて意味を成すものを考えると、値を代入できる場所の指定/参照、となることが多いようです。
Lispのsetfとは、値の読み書きの場所について一般化し、値の読み出しのフォームと同じ見た目のフォームで書き込みも表現しようというものです。
setfは、
(setf 場所 値)という形式ですが、「場所」には、変数名や値をアクセスする記述を使用できます。
一番身近なリスト操作のcarで説明すると、
リストのcar読み出しフォーム
(setq x (list 0 1 2 3)(car x)
→ 0
リストのcar書き込み
(setq x (list 0 1 2 3))
→ (0 1 2 3)(setf (car x) 42)
→ 42
x
→ (42 1 2 3)
となります、Algol風に書けば、
car(x) := list(0, 1, 2, 3)となるでしょうか。
carで読み出して来た場所に、値を代入するという意図が表現できているかと思います。
リストの場合は、配列アクセスの表現にかなり近いので自然な拡張に思えます。
SETFのFが気になる問題
長い歴史を持つLispでは、名前の由来を最早誰もはっきり説明できない関数が結構あります。
実は、setfもそんな名前の一つです。
代入だからsetは良しとして、fはなんだろう、というのはFAQでもありますが、Common Lispのsetfの由来は、L Peter Deutsch氏の論文A LISP machine with very compact programsまで遡ることができます。
代入関数であるsetが変数名だけでなく関数フォームを取れるようにしよう、というのがアイデアの骨子ですが、
setを拡張して、
(set '(fn arg1 ... argn) 42)と書けるようにし、次に同様にsetq版も考えて、
※setqは、set+quoteが由来
(setq (fn arg1 ... argn) 42)と書けるように拡張。しかし、これでは関数フォーム全体をクォートしてしまい引数が評価されないのが実用上不便ということで、関数名だけクォートするものを考案。
(setfq (fn arg1 ... argn) 42)この当時のLISP(INTERLISP系)にバッククォートがあれば、
これがCommon Lispでいうsetfと同じもので、(SETFQ (fn argl ... argn) newvalue) which quotes the function name and evaluates everything else.と表現されています。
ということは、setを使えば、
(set (list 'fn arg1 ... argn) 42)と書けるということでしょうか。
それはさておき、つまりFはfunctionを意図していたようですが、一番流布しているのはFはField説、次にForm説あたりかなと思います。
ちなみに、やたらとクォートの扱いについて細かいと思う人もいるかと思いますが、L Peter Deutsch氏のバックグラウンドであるINTERLISPでは引数が評価されるものと、されないもの二種(q付きとqなし)が大抵用意されているので、引数評価について敏感だったのでしょう。
Common Lispでは、setとsetqの関係ですが、qがquoteを意味しているものとしてはsetqが唯一の生き残りです。
なお、setfqのqはどっかに飛んでいってしまったようです。
今後は、setfのアイデアが最初に登場したと思われるLISP 2の解説、Lisp Machine Lispでの発展あたりについて書いたり、数あるsetfの定義構文を全部解説してみようかなと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
Egison Workshop 2018に参加してきました!
Posted 2018-11-25 08:33:06 GMT
2018-11-23の祝日に開催されたEgison Workshop 2018に参加してきました。
Egisonの現状と今後の展望 - 江木聡志 (楽天技術研究所)
まずは、Egison開発の歴史についての発表でした。
開発動機に始まり現在注力している数式処理機能、テンソルの添字記法等まで解説がありました。
EgisonはあくまでProof of conceptとのことで、今後Haskellへの組み込み機能としても展開していったりするようです。
先日開催されたML Day #2でのEgisonの発表資料
Egison入門+論文紹介 - 西脇友一 (東京大学)
Egisonの入門解説と、来たる12月に開催されるAPLAS 2018で発表予定の Non-linear Pattern Matching with Backtracking for Non-free Data Types の解説でした。
まずは、Egisonに慣れてもらうということで、Egisonのパターンマッチの解説が大目で、論文の内容はざっと、という感じでした。
Egisonパターンマッチのアルゴリズムとマッチャー定義 - 江木聡志 (楽天技術研究所)
Egisonのマッチャーのアルゴリズム解説に始まり、無限の大きさの探索空間に対して適切にマッチさせるための工夫のについて解説されました。
こちらも先日開催されたML Day #2でのEgisonの発表資料に詳しいです。
Egisonプログラミングコンテスト
出題をEgisonで解くという内容でした。
member?、reverse、というリスト処理では初等的な内容でしたが、Egison流の書法に慣れていない参加者が大半だったため意外と苦戦(私も)しているようでした。
問題集を眺めると、「ポーカーの役判定」までありましたが、そこまでは辿り着かず。
ちゃんと予習していけば良かった……。
Egisonの型システムとその型推論器の実装 - 河田旺 (京都大学)
Egisonに型推論器etcを実装したTyped Egisonを開発している中でのあれこれについてが解説されました。
新機能で知るEgison - 郡茉友子 (東京大学)
テンソルの添字記法に代表される数式処理用の記法を実装するにあたってのあれこれ、EgisonをJupyterで使うためのegison_kernelの紹介、S式がつらいということで、EgisonのHaskell風の構文拡張の紹介でした。
Haskell風のシンタックスについては、egison 4.0に向けての計画の一つなのかもしれませんが、発表内容のものと同一のものなのか、それとは独立の実装なのかメモするのを忘れてしまいました。
現在、対話的に使った際のエラー処理は手厚くないとのことで、新構文で記述→ファイルを読み込み、というフローで使ってみて欲しい、とのことでした。
Lispをやっていて、S式アレルギーの人が一定数いる(大多数)のは十二分に把握しているので、EgisonがS式を採用した理由とメリットについて質問してみましたが、江木さんより、別段にS式に対するこだわりはないという回答でした。
それをうけて私が「S式に対する熱い思いがあるのかと思いました」と発言したところで妙に会場のウケをとってしまい、もしかしたら、Haskell風の構文について質問/紹介するタイミングをつぶしてしまったかもしれません(すいません)
Egisonで微分幾何 - 江木聡志 (楽天技術研究所)
こちらも先日開催されたML Day #2でのEgisonの発表資料に詳しいという感じでした。
懇親会
希望者で懇親会が開催されましたが、参加者間で濃い議論が行なわれていたようです。
私はLisp/S式推しで喋っていましたが、ちょっとウザかったかもしれません(正直すいません)
まとめ
S式構文、パターンマッチ、数式処理、と揃ったので、勝手にREDUCE、MACSYMA/Maximaの系譜に続くEgisonキタコレと思ってしまったのですが、主軸はそこではなく、パターンマッチの可能性と記法を追求する途上でたまたまS式、ということのようです。
……ついでにおまけで良いからS式の可能性も追求して欲しい!
全般的にEgison Workshop 2018は、色々な要素のバランスが良く楽しいワークショップでした。
また、参加者にはもれなくEgison Tシャツが配布されました。
Egison Tシャツ欲しかったのでうれしい!
次回のワークショップも期待しています。
■
HTML generated by 3bmd in LispWorks 7.0.0
対称性にこだわるGLSと継続と多値
Posted 2018-11-14 20:02:05 GMT
前回、多値についてCommon Lisp以前のLisp Machine Lispから眺めてみました。
色々な資料を眺めている中で、GLS(Guy L. Steel Jr.氏)の多値についてのスタンスが、使い勝手の方に舵を切ったCommon Lispと美しさを取ったSchemeを象徴するように見えたので、GLSと多値について書いてみたいと思います。
タイトルに継続と多値と入っていますが、GLSが多値と継続について語っているのを見付けただけです。継続に興味ある方々には、釣りタイトルみたいになってしまってすいません :)
初期のLisp Machine Lispの多値とGLS
初期のLisp Machine Lispの多値の高レベルAPIにはmultiple-value-listとmultiple-value、があり、returnは多値を返せました。
multiple-valueはCommon Lispでは、命名が良くないということで、multiple-value-setqと改名されましたが、当初は代入フォームがメインだったようです。
multiple-value-bindのような束縛構文はというと、調べた限りでは、GLSが提案したものが最初で1977-03-07のメールに詳細が書いてあります。
名前は、Common Lispと同じmultiple-value-bindです。
GLSが提案した形式は、
(MULTIPLE-VALUE-BIND <function call>
<bindings>
<body>)というもので、現在のものとは、変数と多値を返すフォームの位置が反対になっています。
この提案では、束縛部ではオプショナル引数や残余引数の指定ができることが示唆されています。
(MULTIPLE-VALUE-BIND (FOO A B C)
(VAL1 VAL2 &OPTIONAL VAL3) ...)
or
(MULTIPLE-VALUE-BIND (FOO A B C D E)
(VAL1 VAL2 &REST VAL3) ...)さらに、入出力の多値の数をしっかり合せたい場合、
(MULTIPLE-VALUE-BIND (BAR B C)
(G0001 &REST G0002)
(FOO A G0001 D E))と書けることを挙げて、
This idea lends a nice symmetry to the passing of arguments and
the returning of values. Finally, one might note that this also
allows the possibility of specifying that NO values are expected back.
PROG could evaluate statements in this mode, while evaluation
of subforms should require at least one return value.
This lends itself to a better theory of statements vs. forms.と締めています。
多値の入出力の対称性を実現でき、さらに発展して値を返すフォームを式、返さないフォームを文とできる、ということみたいです。
この提案に反応があったのか無かったのか記録には残っていないのですが、結局この仕様はそのままは取り入れられず、Common Lispでもお馴染の形式のものが1979年に導入されています。
初期のCommon Lisp仕様策定と多値とGLS
時は流れて1981年。初期Common Lispの仕様の議論ですが、当時のmultiple-value-bindの仕様(=現在のCommon Lispの仕様)を少し変更して変数部をlambdaと同じにしたらどうか(つまり上述の1977の仕様と同じ)と提案しています。
I propose that the list of variables be completely identical in syntax
to a LAMBDA-list. This includes the use of &OPTIONAL and &REST. One
can get precisely the current functionality by inserting &OPTIONAL at
the front of the variables list. In addition, one would be able to get
non-NIL default values; a list of some of the values, using &REST;
and better error checking, because one can *require* that certain values
be delivered.現在のmultiple-value-bindと何が違うかというと、GLSのものは多値の数をきっちり合せることが前提のインターフェイスになっていて、合わなければエラーになるというところです。
(defmacro gls-multiple-value-bind (args mv-form &body body)
`(multiple-value-call (lambda ,args ,@body) ,mv-form))(gls-multiple-value-bind (a b)
(values 0 1 2)
(list a b))
;error> got 3 args, wanted 2.
(gls-multiple-value-bind (a b &optional c)
(values 0 1)
(list a b c))
→ (0 1 nil)
この提案に対してのDavid Moon氏からの回答が「実用指向のCommon Lisp™」という感じなのですが、実際の所、多値を返す殆どの関数は、それを使う側がいらない多値は捨てるものという前提で運用されていて、理論的に考えられるような対称性はみられない、として切り捨てています。
This sounds superficially plausible and has been proposed many times before.
The reason it has never been accepted is that in practice most functions
which return multiple values rely on the feature that extra values the
caller does not want are thrown away. Calling and returning aren't really
as symmetric in practice as they are in theory. It probably would be useful
to have a way of requiring at least a certain number of values to be
returned. Of course, then all the functions which rely on extra values
being supplied NIL would have to be fixed. This is pretty common practice
when you have code like (and <condition> (values <val1> <val2>)).Schemeと多値と継続とGLS
また時は流れて、1988年、Schemeメーリングリストでのことですが、GLSがSchemeの会合で継続を踏まえた多値の扱いについて話をするつもり、という旨のメールを書いています。
このメールでは、数あるLisp方言で、それぞれ多値の返却/受取で数が合わない場合の対処も違うけれど、継続と多値の問題と見做せるとしています。
また、継続は返却/受取の数は一致していることを基本とし、その上で継続に多値の数が一致しているかを問合せるaccepts?というものを提案しています。
accepts?と使うとCommon Lispの多値のような挙動は下記のように書けるようです。
;;; cwcc = call-with-current-continuation
(define (values . r)
(define (ignore-excess-values k z)
(if (accepts? k (length z))
(apply k z)
(if (null z)
(supply-default-falses k r)
(ignore-excess-values k (cdr z)))))
(define (supply-default-falses k z)
(if (accepts? k (length z))
(apply k z)
(supply-default-falses k (cons '#f z))))
(cwcc (lambda (k) (ignore-excess-values k r))))さらに、beginやset!は0個の値を返すのはどうかという話もでてきますが、これも上述の1977年のアイデアですね。
まとめ
多値の返却/受取の個数合せについて、使い勝手の良い挙動でまとめたCommon Lispと、あるべき挙動を選択したScheme、そして時代と方言を越えて一貫した主張をしていたGLSを眺めてみました。
Schemeで多値と継続についての議論がどの辺りからあるのかは調べていないのですが、発表する内容として考えられていたことからしても1988年のGLSの提案が割と初期のものなのではないでしょうか。
ちなみにR7RSでもaccepts?のようなものは仕様には取り入れられていないようです。
Common Lispでは、失敗/成功のフラグをアドホックに多値の二値目で表現するようなことをします。
まさに、多値が導入された当初の目的で使っている感じですが、数合わせしないといけなくなるとすると、ちょっと面倒ですね。
■
HTML generated by 3bmd in LispWorks 7.0.0
Lispと多値
Posted 2018-11-12 19:54:32 GMT
Goの多値についての記事が人気のようで、この数日Twitterで多値の話題が賑わっています。
多値が話題になることなど、そうそうないですが、多値といえばやっぱりCommon Lispでしょう!、ということでLispと多値について書いてみます。
Lispと多値の歴史
多値といえばCommon Lispですが、最初の仕様のCommon Lisp(1984)でも標準の言語機能になっています。
Common Lispの人達は、普段から普通に便利に使っていますが、多値周りはシンプルなデザインなので使い方で混乱する、ということも特にないでしょう。
典型的な使われ方には下記のようなものがあります。
しかし、その多値機能ですが、Common Lispで初導入という訳ではなく、直接の祖先であるLisp Machine Lispにから輸入したものです。
ということで、Lisp Machine Lispの歴史を遡ってみましたが、私が調べた限りでは、多値が導入されたのは、1976年辺りのMIT LispマシンのCONSのようです。
LISP Machine Progress Report(1977)では、
A traditional weakness of Lisp has been that functions have to
take a fixed number of arguments. Various implementations have added
kludges to allow variable numbers of arguments; these, however, tend
either to slow down the function-calling mechanism, even when the
feature is not used, or to force peculiar programming styles.
Lisp-machine Lisp allows functions to have optional parameters with
automatic user-controlled defaulting to an arbitrary expression in the
case where a corresponding argument is not supplied. It is also
possible to have a "rest" parameter, which is bound to a list of the
arguments not bound to previous parameters. This is frequently
important to simplify system programs and their interfaces. A similar problem with Lisp function calling occurs when one
wants to return more than one value. Traditionally one either returns
a list or stores some of the values into global variables. In Lisp
machine Lisp, there is a multiple-value-return feature which allows
multiple values to be returned without going through either of the
above subterfuges.
という風に、入力側のオプショナル引数と、出力側の多値の対で語られています。
複数の値を返したい、というニーズがそんなにあったのかは不明ですが、リストで返したり、大域変数経由で渡すところを多値機構として、すっきり纏めたという話は、それはそれで説得力があるという所でしょうか。
MIT LispマシンはSECDマシンに非常に近い構成らしいので、専用マシンは多値をハードウェア支援で高速に実現できますよ!的な記述も探してみましたが、そういう話はみつけられませんでした。残念。
興味のある方向にCONS時代のLispのマニュアルを置いておきます。
このマニュアルでは、%CALL-MULT-VALUEや、%RETURN-N等のプリミティブが定義されていることが判ります。
ちなみに、Scheme方面では、恐らく1980年代前半にTが最初に導入し、その後紆余曲折を経てR5RSで仕様化されたようです。
Schemeも元を辿れば、Lisp Machine Lisp由来かなと思います。
Common Lispでの多値の扱い
多値の扱いを考える場合、N個の値を返す場合と、受けとる場合にどうなるかを考慮する必要がありますが、Common Lispでは下記のようになります。
値を返す
- フォームは0個以上の値を返す
値を受け取る
- 関数は単値のみ受けとる
- 関数は二つ目以降は無視する
- 0個の場合、
nilを受け取る - 関数以外のスペシャルオペレーター/標準マクロには個別に規定がある
詳細は、Common Lispの仕様を参照してください。
スペシャルオペレーター/標準マクロの個別の規定ですが、過剰であれば無視され、足りなければ、nilが補われる動作と考えて問題ないと思います(multiple-value-call以外は)。
ただこの挙動をもって、Common Lispの多値機構の挙動と見做せるかというと、そうではなく、そういう風にフォーム構成されているだけという点に注意が必要かなと思います。
受取り側が期待した個数より少なければnilで補填され、敷衍して0個の場合はnilとなるのがCommon Lispの多値機構、という訳ではありません。
例えば、multiple-value-bindは足りない場所はnilを補い、過剰な場合は捨てますが、
(multiple-value-bind (q r s)
(floor 1 2)
(list q r s))
;=> (0 1 nil) それは、多値を引数リストにする時にオプショナル引数のように処理しているからで、入出力の多値の個数が一致していなければ、エラーにすることも可能です。
また、nil以外のデフォルト値を設定することも可能でしょう。
(defmacro strict-multiple-value-bind ((&rest vars) mv-form &body body)
`(multiple-value-call (lambda (,@vars) ,@body) ,mv-form))(strict-multiple-value-bind (q r s)
(floor 1 2)
(list q r))
;error> got 2 args, wanted at least 3.
まとめ
以上ですが、Common Lispでは、継続と多値があまり連続した議論になっていないのがお判りでしょうか。
このまま書き進んで行こうと思いましたが、長くなったので、続きは別の回にしたいと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
NILの商用版が存在していた!
Posted 2018-10-01 17:53:43 GMT
先日 @hatsugai さんからLisp関係の記事があるということで1986年のInformation(インフォメーションサイエンス社)というコンピューター月刊誌をお借りしました。
このInformationですが、1986年は第二次AIブームのまっさなかということで、面白い記事が多かったです。
AIワークステーション花盛りという感じで興味深い広告も多いのですが、その中でも目にとまったのが、裏表紙のMicroVAX IIの広告です。
MicroVAX IIもAI対応してますよ!という広告なのですが、用意されているAI言語として、当時かなりシェアが高かったFranz LispとNILの名があります。
……NIL! NILが商用化されていたとは!
広告の文言をそのまま引用すると、
■NIL
MIT AI Lab. で開発されたCommon LISP
米国Impediment(製)
とのことで、Impediment社があつかっているということですが、LispはSpeech Impedimentみたいなので、そんな洒落を社名にするならLisp関係の会社でしょうか。
早速ネットを検索してみたりしていたのですが、Impediment inc という検索ワードで、それらしき情報が出てきました。
この記事によると、マシンスペック 5-16メガRAMのVAXで稼動し、Fravorsによるウィンドウシステム、Emacs系エディタが開発環境として用意されていますようです。
Fravorsによるウィンドウシステムは、ウィンドウシステムまるごとなのかVAXのものにのっかったものなのか知りたいところです(当時だと丸ごと作っていそう)が、Lispマシンのものを移植したりしていそうです。
Emacs系エディタについては、NILのマニュアルではSteveというものが標準エディタとして解説されていますので、多分Steveが動いたのではないでしょうか。 ちなみに、Steveの他にNileというものがあったとWikipediaに記載がありますが、実在したのかは未詳。
Impediment社は90年代からウェブサイトを所有しているようで、現在もドメインは活きているようですが、ウェブサイト自体は落ちているようです。 会社の住所は1985年の記事のものと同じようなので同一の会社かと思われます。
whoisで所有者情報を確認してみたところ、Alexander Sunguroff氏が管理者の様子。過去のAI関係の記事に社名と一緒に紹介されているようなので経営者のようにみえます。
Sunguroff氏は、1970年代初頭にはProject MACに関わっていたようで、主に初期のMultics MACLISPの開発にDavid Moon、….氏と共に携わっていたようです。
また、MACLISPマニュアルの定番である1974年版はDavid Moon氏とSunguroff誌が一緒にまとめたようです。
NILは、MITでのLisp Machineプロジェクトと同じく、MACLISPの後継ですが、後にCommon Lispの礎となり、自らもCommon Lispのスーパーセットとなりました。 Common Lispがレキシカルスコープを採用したのは直接的にはNILの影響だといわれています(当事者達曰く)
この辺りの経緯を鑑みるに、筋金入りのLisperであるSunguroff氏が1984年あたりに宙ぶらりんになっていたNILを商用化するために会社を興してもおかしくはないなと推理しているのですが、真相やいかに。
当時のLisp環境の最高峰といえば、Lispマシンでしたが、汎用機上のライバル達もLispマシンに追い付け追い越せで、Lisp OS、ウィンドウシステム完備のGUI、Lisp向けエディタ(Emacs etc)を一式揃えて勝負していましたので、NILもOSこそLisp OSではないものの、そんな感じだったのではないかと思います。
NILはMIT内で利用されていたのみと思っていたのですが、製品として世に流通していたとすれば、そのうち誰かが発掘してbitsaversにでも置いてくれるかもしれません。
いつかNILを起動してみたい……。
■
HTML generated by 3bmd in LispWorks 7.0.0
SBCL 1.4.12のfold-identical-codeを試してみた
Posted 2018-09-29 19:35:02 GMT
今月も月末にSBCLの新バージョンがリリースされましたが、リリースノートに、
- SBCL All News: 1.4.12
enhancement: identical code (at the machine instruction level) can now be shared between functions, if explicitly requested.
とあり、どんな機能か気になったので調べてみました。
fold-identical-code
ちょっと調べても説明もなく良く分からなかったので、githubのコミットログを眺めましたが、fold-identical-codeとかいうのが、その機能のようです。
fold-identical-code を使ってみる
どう使うのかは、良く分かりませんが、
fold-identical-codeが定義されているsrc/code/icf.lispに
;;;; Identical Code Folding (similar to what might be done by a C linker)とあるのでコードサイズの縮小あたりが狙いなのかもしれません。
とりあえず、下記のような同じ内容の関数を定義してみてからfold-identical-codeを実行してみると、
(progn
(defun foo (x) (+ 42 x))
(defun bar (x) (+ 42 x))
(defun baz (x) (+ 42 x)))(fold-identical-code :aggressive t :print t)
以下のようにずらっと結果が表示されますが、
#<code id=154F2 [1] baz {53FD93CF}> = #<code id=154F0 [1] foo {53FD92AF}>
#<code id=154F1 [1] bar {53FD933F}> = #<code id=154F0 [1] foo {53FD92AF}>barとbazはfooにまとめられているようです。
使用メモリの削減具合を確認するためにイメージをダンプしてみましたが、135MiBのイメージが、ダンプ時にfold-identical-codeを実行してからダンプすると、134MiBに縮みました。
1%も縮まっていない感じですが、C++等のリンカの最適化を解説しているページによると、重複の削除によって1〜2%縮むと書いてあるものが多いようなので、そんなものなのでしょう。
むすび
今の所ドキュメントは整備されておらず、src/code/icf.lispsrc/code/icf.lispを読むしかない感じですが、今後整備されていくと思うので期待して待ちたいです。
ちなみに当初自分が期待していたのは、disassembleした時のインストラクションが同一になるかどうか確かめるユーティリティだったのですが、下記のようにfold-identical-codeの部品であるsb-vm::code-equivalent-pを使って判定できるようです。
(defun fun-code-equivalent-p (f g)
(sb-vm::code-equivalent-p (list (sb-c::fun-code-header f))
(list (sb-c::fun-code-header g))))(fun-code-equivalent-p #'foo #'bar)
;=> t
ごくたまに欲しい時があって、disassemble関数の中身を使って自作していましたが、sb-vm::code-equivalent-pを使った方が正確に判定できるようなので、今後はこちらを使おうかなと思っています。
■
HTML generated by 3bmd in LispWorks 7.0.0
Shibuya.lisp 発足十周年おめでとう
Posted 2018-09-17 16:46:09 GMT
いきなりですが……、Shibuya.lisp 発足は十年前の2008-09-18だと思っていましたが、2008-09-08でした……。
日付間違えて覚えてて10周年過ぎてました。なんてこったい。
自分は、発足当初のスタッフで途中で交代した人間ですが、10年も続いているのは素晴しいなと思います。
ざっとこの十年を振り返ってみると、テクニカルトークと、Lisp Meet Upがあります。
最近は、もくもく会というものあるようです。
- 2008-10-18 Shibuya.lisp テクニカルトーク#1
- 2009-02-28 Shibuya.lisp テクニカルトーク#2
- 2009-07-04 Shibuya.lisp テクニカルトーク#3
- 2009-11-07 Shibuya.lisp テクニカルトーク#4
- 2010-03-20 Shibuya.lisp テクニカルトーク#5
- 2010-11-27 Shibuya.lisp テクニカルトーク#6
- 2011-09-26 Shibuya.lisp テクニカルトーク#7
- 2014-08-30 Shibuya.lisp テクニカルトーク#8
- 2013-01-22/2018-09-27 Lisp Meet Up presented by Shibuya.lisp #1/#68
Lisp Meet Upの方は、今月開催分で実に68回目。
Lisp Meet Upは、なわたさんを中心として企画され始まったと記憶していますが、Meet Upがなければ2012年あたりで実質消滅していたかもしれないなと思います。
テクニカルトークの方は、大体50から100人程度の参加者で開催していたものですが、開催の負担が大きかったこともあり、2014年以降は開催されていません。
まあでも最近だと100名程度の参加者であれば手軽に開催できるイベント会場があるようなので、発表さえ揃えられれば開催できるのかもしれません。
この十年の傾向
2008年頃は、勉強会ブームがあり、また言語を学ぼうというブームがありました。
Lisp系言語では日本のSchemeの代表格であるGaucheが圧倒的だったと記憶しています。
一方、Common Lispグループは割と草の根的に活動していき、地味にネットワークを広げていったようです。
言語学習ブームが去りつつあった2011年あたりから、Schemeでなにか発表しようという人は少なくなる一方で、Clojureが擡頭してきて、Lisp Meet Upは、Common LispとClojureを中心にして今に至るようです。
Schemeは端から眺める限りでは、Schemer＝処理系開発者という感じなのでユーザーが集まって何かするより、開発者間で議論して個人間で盛り上がるという感じに見えたので、言語がコミュニティを形成させる上での形質の違いのようなものがあるのかもしれません。
現在では、業務でCommon Lisp、Clojureを書く人材/職場の交流もShibuya.lispをきっかけにして、ということも多々あるようです。
まとめ
次の十年の継続と発展を期待しています!
■
HTML generated by 3bmd in LispWorks 7.0.0
boundpがGeneralized Booleanを返す謎
Posted 2018-08-29 09:56:05 GMT
Common Lisp仕様策定のメーリングリストで、RMSが()とNILは区別すべき、という主張をしていて、そうした場合の御利益について説明しているのをみつけたので眺めていました。
NILと()を区別すべきという主張はさておき、文末の方にCommon LispでいうGeneralized Booleanのアイデアが紹介されています。
RMS:
The general principle is: if a predicate FOO-P is true if given
falsehood as an argument, FOO-P should always return an object
of which FOO-P is true.
If, on the other hand, FOO-P is false when given falsehood as an
argument, then FOO-P should always return its argument to
indicate truth.
foo-pが真の時は、述語の与えられたオブジェクトを返すということの一般化ですが、Common LispでのGeneralized Booleanは、ざっとHyperSpecを数えたところ99個あるようです。
next-method-p remf slot-exists-p random-state-p simple-string-p
wild-pathname-p compiled-function-p slot-boundp graphic-char-p arrayp
string= string-equal simple-bit-vector-p array-in-bounds-p functionp
fboundp hash-table-p tree-equal symbolp listen input-stream-p
output-stream-p listp readtablep = /= < > <= >= pathname-match-p atom
streamp delete-package eq boundp keywordp logtest remprop characterp
open-stream-p every notevery notany unintern pathnamep complexp
alphanumericp realp simple-vector-p y-or-n-p yes-or-no-p eql vectorp
endp equal stringp remhash interactive-stream-p packagep evenp oddp
bit-vector-p subsetp alpha-char-p load minusp plusp numberp typep
adjustable-array-p zerop standard-char-p logbitp constantp tailp
special-operator-p rationalp array-has-fill-pointer-p char= char/=
char< char> char<= char>= char-equal char-not-equal char-lessp
char-greaterp char-not-greaterp char-not-lessp upper-case-p
lower-case-p both-case-p ldb-test fresh-line integerp equalp conspboundpの謎
Generalized Booleanとして機能した場合に返す値が謎なものは結構ありますが、中でも、boundpが気になります。
cl:nilは偽値であるcl:nilに束縛されているので、(boundp 'cl:nil) => Tと真値を返すわけですが、これをGeneralized Boolean化した場合、(boundp 'foo)がfooシンボルを返すのは良いとして、cl:nilシンボルでcl:nilを返したら偽になってしまいます。
上記のRMSのメールでは、こういう場合は、Tを返すようなことを書いていますが、Generalized Booleanとしての機能は果すものの、今度は、(boundp 'cl:NIL)と(boundp 'cl:T)を区別できなくなります。
まとめ
Generalized Booleanを返しても良いもののうち、実際の利用例については首をひねるものは、boundp以外にも結構ありますので、暇潰しに考察するのも一興かなと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
色々な言語でCommon Lispのコードを書いてみよう
Posted 2018-08-27 17:23:54 GMT
色々な言語でCommon Lispのコードを書いてみたら、どうかなと思い試してみました。
だからなんなの、というような試みです。
コード例はお馴染みのfibにします。
Common Lisp
大元のCommon Lispです。
quoteを付ければデータになりますが、一応listでリストを生成するものも書いてみます。
'(defun fib (n)
(if (< n 2)
n
(+ (fib (1- n))
(fib (- n 2)))))(list 'defun
'fib
(list 'n)
(list 'if
(list '< 'n '2)
'n
(list '+
(list 'fib (list '1- 'n))
(list 'fib (list '- 'n 2)))))当然ながらevalすれば、コードとして実行できます。
Racket
まあ、RacketもCommon Lispもそのまんまですね。
1-というシンボルは関数名としては不可だった気もします。
'(defun fib (n) (if (< n 2) n (+ (fib (1- n)) (fib (- n 2)))))defun等々の関数を定義すれば、そのまま動かせると思います。
Python
PythonではCLのリストに相当するものは配列になるでしょう。
ASTやシンボルへのアクセスもできるようですが、とりあえず、面倒なのでシンボルは文字列としておきます。
['defun',
'fib',
['n'],
['if',
['<', 'n', 2],
'n',
['+', ['fib', ['1-', 'n']], ['fib', ['-', 'n', 2]]]]]上のコードを動かすにはインタプリタを作成する感じなんでしょうか。
Ruby
RubyもPythonと似た感じですが、シンボルがあるので使ってみました。
[:defun,
:fib,
[:n],
[:if, [:<, :n, 2], :n, [:+, [:fib, [:"1-", :n]], [:fib, [:-, :n, 2]]]]]Erlang
何故Erlangという気もしますが、Prologっぽいので試してみました。
やはりシンボルがあるので扱いが楽です。
[defun,fib,[n],['if',['<',n,2],n,['+',[fib,['1-',n]],[fib,['-',n,2]]]]]Prolog
Prologは、Lispと同様、基本のデータ型がリストです。Lispのシンボルはアトムに相当するでしょうか。
[defun,fib,[n],[if,[<,n,2],n,[+,[fib,[1-,n]],[fib,[-,n,2]]]]]Julia
最近ブレイクしつつあるような気がするJuliaですが、シンボルがあるので、そこそこ素直に書けます。
[:defun, :fib, [:n], [:if, [:<, :n, 2], :n, [:+, [:fib, [Symbol("1-"), :n]], [:fib, [:-, :n, 2]]]]]データをコードにする仕組みが割と身近に存在するようで、文字列をパーズしてExpr型というコードに変換することが可能です。
julia> xpr="function fib(n)
if n < 2
n
else
fib(n - 1) + fib(n - 2)
end
end"julia> Meta.parse(xpr)
:(function fib(n)
#= none:2 =#
if n < 2
#= none:3 =#
n
else
#= none:5 =#
fib(n - 1) + fib(n - 2)
end
end)
julia> Meta.show_sexpr(Meta.parse(xpr))
(:function, (:call, :fib, :n), (:block,
:(#= none:2 =#),
(:if, (:call, :<, :n, 2), (:block,
:(#= none:3 =#),
:n
), (:block,
:(#= none:5 =#),
(:call, :+, (:call, :fib, (:call, :-, :n, 1)), (:call, :fib, (:call, :-, :n, 2)))
))
))
コードをExprで直接記述することもできるようで、この辺りは、まんまLispの前置記法ですね。
Expr(:function, Expr(:call, :fib, :n),
Expr(:if, Expr(:call, :<, :n, 2),
:n,
Expr(:call, :+,
Expr(:call, :fib, Expr(:call, :-, :n, 1)),
Expr(:call, :fib, Expr(:call, :-, :n, 2)))))(追記) Squeak/Pharo Smalltalk
ブログの内容が謎コンテンツでしたが、意外にもSmalltalk方面から反応を頂きました。
ありがとうございます🙇
「色々な言語でCommon Lispのコードを書いてみよう」https://t.co/AlI5lmFhvd をSqueak/Pharo Smalltalkで。
— sumim (@sumim) 2018年8月28日
#(defun fib (n) (if (< n 2) n (+ (fib (#'1-' n)) (fib (- n 2)))))
多くのSmalltalkの処理系ではリテラル配列表現の要素となるシンボルは#を省略できるので少しLispっぽく書けます。
シンボルがあるSmalltalkもかなりLispっぽく書けますね。しかも丸括弧。
まとめ
Common Lispは、プログラムを文字のつづりというよりは、言語処理系のリスト型とシンボルで記述しますが、他の言語のデータ型を使ってCommon Lispのコードを書いてみたら面白いかなと思って試してみました。
当然ながら、やっぱり、Lisp、Prologあたりは、この辺りの処理はしやすいですね。
Juliaは数値計算にフォーカスしているものと思っていましたが、案外Lisp的なコード=データな文化も継承しているようで、なかなか面白いと思いました。
■
HTML generated by 3bmd in LispWorks 7.0.0
キーワード引数のキーワードを定数として宣言してつかう
Posted 2018-07-01 15:01:17 GMT
三年以上寝かせたアイデアですが、まったく有用なケースを見出せていません。
(defconstant ? :test)(member "a" '("b" "c" "a") ? #'string=)
→ ("a")
何か活用法あるでしょうか。
ちなみに、いまのところ有用なケースは見出せていませんが、マクロやコンパイラマクロの引数定義をめんどくさくしたりコンパイラの最適化を阻害する欠点はあるなとは思いました。
■
HTML generated by 3bmd in LispWorks 7.0.0
MACLISPでアラビア数字・ローマ数字変換
Posted 2018-06-20 14:39:53 GMT
最近、過去のブログ記事を眺めかえしたりしているのですが、shiroさんのブログに、アラビア数字・ローマ数字変換ネタがあり、
formatの~@Rに対称な機能がparse-integerに無いのは美しく無いよなあ。
とありました。
私は、MACLISPは対称の筈だ!と思いMACLISP用のコードを書き始めましたが、どうも昔に書いたことがあると思いローカルのファイルを検索してみると、どうやら記事を読んだ当時に書いていたようで、ついでにGitHubにコードもアップしてました。
これが可能なのはMACLISPは基数にローマ数字を指定できるからなのですが、詳細は関連記事の動画を参照してください。
どうして当時記事にしなかったのだろう。マニアックすぎたからだろうか……。
関連記事
■
HTML generated by 3bmd in LispWorks 7.0.0
C++のstd::find_ifの名前の由来はCommon Lispのfind-ifだった
Posted 2018-06-17 17:40:10 GMT
表題の通りで、だからなんだよといわれればそうなのですが、以前、C++ STLにCommon Lispの影響はあるのかを探る旅に出ていました。
この記事の結論としては、明言はされていないものの、Common Lispのシークエンス関数をごっそり取り入れているようにしか見えないので、Common Lispが元ネタはじゃないだろうか、という感じでしたが、先日Stepanov先生の「その数式、プログラムできますか？」を読んでいたところ、find_ifの注釈として脚注に、
"find it if it's there"(あれば検出する)の意。この名前の起源はCommon Lispプログラミング言語にある。
─第10章 プログラミングの基礎概念 P216
と明言されていました。
まあ名前どころじゃなくて、シークエンス系ユーティリティの概念とか挙動は、結構な数が取り込まれていると思いますので、興味のある方はチェックしてみてください。
■
HTML generated by 3bmd in LispWorks 7.0.0
勝手に「日本LispWorksユーザー会(非公式)」を作りました
Posted 2018-05-26 17:39:01 GMT
私の身近にLispWorksを使う人がちらほら増えてきているのですが、バグやパッチの情報だったり、便利な使い方だったりの情報共有をもっと活発にしたいなと思い、Google Groupsで勝手に「日本LispWorksユーザー会(非公式)」というのを作成しました。
主な用途・ターゲットユーザー
- LispWorksのパッチやバグの情報共有
- LispWorks全般、特に日本語処理周りについての情報共有
が主な目的で、その辺りに興味がある方々がターゲットユーザーです
まあ、Lisp Hugメーリングリストで尋ねてみたら?というアドバイスが殆どになってしまうかもしれませんが、それはそれで良いかなと思っています😃
■
HTML generated by 3bmd in LispWorks 7.0.0
an obscure feature of MacLISP
Posted 2018-05-13 13:53:03 GMT
小学館ランダムハウス英和大辞典のオンライン版で、“obscure”の用例に何故かMACLISPが出てきているのを発見しました。
goo 英和・和英辞書 「an obscure feature of MacLISP」の意味
an obscure feature of MacLISP説明書に書かれていない MacLISP (コンピュータ言語)の一特徴.
ちゃんとMITっぽい言い回しですが、一体どこから紛れ込んだのでしょう……。
■
HTML generated by 3bmd in LispWorks 7.0.0
Lispに有理数(分数)が導入されたのはいつ頃なのか
Posted 2018-05-09 15:03:26 GMT
turingcomplete.fm #17 を聴いていたら、Lispと有理数について、またそれはいつ頃導入されたのかという話題がでてきました。
そういえばLispが有理数をサポートしたのっていつ頃なのか私も知らないな、ということでちょっと調べてみましたが、1981年あたりが境ではないかと推測できたものの、結局あまりはっきりしたことは分からず。
とはいえ、折角調べたのでまとめて記事にしてみることにしました。
Common Lisp
しかし、とりあえず「Lispは数値計算周りの仕様が充実している」という評判はCommon Lisp(1984)辺りが始まりのようです。
次にSchemeが、RRRS(1985)でCommon Lisp(1984)の成果を評価し、それを取り入れたようですが、その際にCommon Lispでは定義されていない正確数と非正確数の概念ができたようです。
当時の背景があまり想像できませんが、移植性のある正確数とそうでないものに分けたのでしょうか。
RRRSではCommon Lispより前には体系的に数値計算をまとめたLispはなかったと述べられているので、Common Lispが一つの境なのでしょう。
S-1 Lisp
では、そのCommon Lispは、どこから有理数を取り入れたかというと、当時の科学計算用スーパーコンピュータ用LispであるS-1 Lisp(S-1 NIL)からのようで、取り入れる方針が決まったのは1981年位のことのようです。
Fancy floating point numbers, including complex and rational numbers (this was the primary influence of S-1 Lisp)
S-1 LispはS-1 NILとも呼ばれるように、方言としてはNILであり、Common Lispが制定された頃にはNILはCommon Lispになってしまっているので、どこからNILでどこからCommon Lispかは分かりませんが、数値計算回りでのS-1 Lispの影響は、かなり大きそうです。
S-1 Lispでは、数値計算回りでハードウェアの支援が手厚く、有理数のサポートでもハードウェアの支援を受けることができていたようです。
Lisp Machine Lisp
また、同時期の1981年後半には、S-1 Lispとは独立してLisp Machine Lisp(Zetalisp)(CADR System 74)にも導入されていますが、製品として世の中に出たLispとしては最初のものではないでしょうか(Symbolics/LMIから製品化)。
ちなみに、Lisp Machine Lispの方の有理数は、当初は、エスケープ文字が/なので、3\10のように記述されていましたが後のCommon Lisp化で3/10のように表記されるようになったようです。
また、Lisp Machine Lispでは、Common Lispのように整数との統合はされていないようで1\1と1は別物になるようです。
1981年のLispコミュニティ
Lispコミュニティでは、1981年辺りで有理数の議論がよくされていたようで、1981年あたりに何らかの機運があったのかなと思います。
Lisp、Smalltalkの双方で活躍していたL Peter Deutsch氏がSmalltalk-80には有理数サポートがあるという投稿をしていますが、こういう発言があるということはやはり1981年辺りで有理数をサポートしたメジャーなLisp処理系はなかったのではないかと思います。
- LISP-FORUM: rational arithmetic
- LISP-FORUM: Re: implementation of rational numbers
- LISP-FORUM: Re: Division in Smalltalk
■
HTML generated by 3bmd in LispWorks 7.0.0
いつのまにやらArc公開十周年
Posted 2018-04-15 19:31:36 GMT
すっかり忘れてしまっていましたが、「百年の言語」を体現するarcが公開されたのは、十年前の2008-01-29のことでした。
本当は、今年の01-29に何か書こうと思っていましたが、それさえ忘れて早二ヶ月半……。
arcのソースコードが公開されたのは2008年でしたが、arcで構築されたサイトのHacker Newsは、2007年から稼動しています。
また、名前と構想が発表されたのは、2001年のことなので、かれこれ十八年ともいえなくもないです。
最近のarc
arcの近況を眺めてみましたが、オフィシャルなリリースは、2009-08の3.1から9年間動きなしです。
Hacker Newsを動かしていたのはarcでしたが、2014年にpg氏がY Combinatorの日常業務から引退し、今ではまだarcで動いているのかは良く分からないようです。
軒並動きはないのかと思いましたが、arcのコミュニティが開発しているAnarkiの方は最近も更新があるようです。
Racketに#lang anarkiを作成するなど、なかなか面白そう。
早速、試してみましたが、Racketがインストールされた環境であれば、
raco pkg install anarkiとするだけで導入されます。
あとは、こんな感じで記述しRacketから使えます。 (無理にarcっぽさを出してみました。)
#lang anarki;;; fib.rkt
(:provide fib)
(def fib (n)
(if (< n 2)
n
(+ (fib:- n 2)
(fib:- n 1))))
;; Racket
(require "fib.rtk")(fib 40)
;→ 102334155
むすび
もっと色々書こうと思いましたが、昔の文献を読んでいたらお腹一杯になって満足しました。
参考
- (2012) さあ、Arcをはじめよう | 松村技研
- (2008) Arc's Out
- (2003) 百年の言語
- (2002) なぜArcはとりたててオブジェクト指向でないのか
- (2001) 人気の言語を作るには
- (2001) Arc at 3 Weeks
このブログのarc関係の記事
■
HTML generated by 3bmd in LispWorks 7.0.0
defvar で値を再設定したい時
Posted 2018-04-10 22:09:49 GMT
defvarには値が設定されている場合には再設定をしないという利点がありますが、開発中などはdefvarの値を再設定したい場合がままあります。
こんな時の為に便利マクロを定義するという記事を読みました。
目立たない機能なのであまり知られていないですが、Emacs系のLispエディタ上ではdefvarのフォームを評価したら値が再設定される、という機能があります。
どうやらdefvarが誕生した(1979年頃)からある機能の様子。
(多分、defvar誕生の頃から扱いがめんどくさいという認識があったのでしょう……)
Zmacs(ZWEI)だと、COM-EVALUATE-REGION-HACKというのがあって、defvarをsetqに置き換えて評価するようです。
slimeだとslime-eval-defunで評価すれば、defvarを認識して下請けのslime-re-evaluate-defvarで値を再設定します。
再設定の方法は、一度makunboundしています。
LispWorksだと、“Evaluate Defun”が“Reevaluate Defvar”を呼んで再設定します。slimeと同じくmakunboundするようです。
エディタ変数editor::evaluate-defvar-actionの値が、:reevaluate-and-warnか:reevaluateの場合だけこの動作になるので好みで入切可能です(デフォルトは有効)
Hemlockだと、“Re-evaluate Defvar” コマンドのみで、“Evaluate Defun”とは連動しないようです。こちらもmakunboundして再設定。
新しい値でsetqするものかと思っていましたが、案外makunboundで処理する方式の方が多いみたいですね。
むすび
“Reevaluate Defvar”は、リージョンを評価した時などにも発動していることがあります。
大抵の開発時は、再評価してもらった方が嬉しいですが、defvarの値設定まわりがどうも不思議な挙動だなと思ったら、確認してみるのも良いかと思います。
関連
■
HTML generated by 3bmd in LispWorks 7.0.0
CONSマシン時代のLisp Machine Lispのマニュアル
Posted 2018-04-04 19:46:48 GMT
MIT Lispマシンのソースディレクトリを漁っていたら、MITの最初のLispマシンであるCONS時代のLisp Machine Lispのマニュアルらしきものをみつけたので、html化してみました。
日付は、1977-06-08ですが、CONS時代のドキュメントであるAIM-444: LISP Machine Progress Reportと照らし合わせてもCONS時代で間違いないようです。
AIM-444の最後に書いてあるように、プロトタイプであるCONSは、1977年に一応の完成となり、1978年あたりから実用を目的としたCADRの開発が始まります。
CONS時代のLisp Machine Lispで興味深い所
EVERYやSOMEはINTERLISPから輸入してきたものであることが書かれていたりします。
また、CONS時代にはまだ、パッケージがないのですが、どうやら接頭辞で管理していたようです。
雰囲気としては今のEmacs Lispに近いですが、これらは、PREFIX REGISTRYのまとまりとして何らかのお作法があった様子。
現在のCommon Lispにも存在するread-from-stringが既にありますが、read-は接頭辞だったようなので、当初は、Common Lispでいうとread:from-stringみたいな感じだったのかもしれません。
しかし、これらの接頭辞は、その後パッケージができても名前はそのまま変更されることもなく後の慣習と混ざり、なんとなく命名規約が二重になった感じを残したようです。
また、現在のLispでは単語を-で繋ぎますが、一部_で繋いだものも存在したようです。これらは後に-で統一されます。
%は現在の命名慣習でも公でない内部関数を表わしたりしますが、初期のLisp Machine Lispでもそのようです。
この後、CADR時代になってくると、マイクロコードで書かれた低レイヤーのサブプリミティブで値を返すことが前提になっていないものに%が付くという慣習になって行ったようです。
%が重なる%%の命名規約は謎です。安直に考えると、さらに内部の関数という感じですが、どうもそうでもない雰囲気があります。
面白いのが、下請けを意味する*と併用されたりすることで、例えば、%*NCONCは、可変長のNCONCの二引数版でかつ公でない関数、という感じになります。また、%*GENSYM-COUNTERのように変数に適用されることもあるようです。
TRACE-
GRIND-
TV-
PC-PPR-
KBD-
FILE-
PRINT-
READ-
FASL-
ED-
ED-COM-
%
%%
*
%*
DTP-
%%Q-
CDR-
%%AREA-MODE-
FSM-
%SYS-COM-
ADI-
%%ADI-
LP-
%%LP-
%%ARG-DESC-
%FEF-
%%FEF-
FEF-
%%ARRAY-
%ARRAY-
ARRAY-
ART-
FEFH-
%FEFH-
%%FEFH-
FEFHI-
%%FEFHI-
%%PHT1-
%%PHT2-
%PHT-
SG-
%%SG-
MESA-
%%MESA-むすび
CONS時代のLispがどのようなものだったかの資料は少なく、AIM-444: LISP Machine Progress Reportに書いてあることも謎が多かったのですが、このマニュアルで若干謎が解明されました。
また、Lisp Machine LispはCADRから始まるような印象がありましたが、初期のものを含めると1975、6年あたりから存在するといえそうです。
■
HTML generated by 3bmd in LispWorks 7.0.0
マストドンにreddit r/lisp r/lisp_jaの新着ボットをつくりました
Common LispのLOOPやFORMATを真似した例は割とある
Posted 2018-03-28 07:45:44 GMT
失敗とは呼びたくないんですが、Common Lispのformatとかloopマクロとか、絶対誰も真似しないだろうから、誰か真似してほしい
— 淡中☆圏 (@tannakaken) 2018年3月26日
実際の所、LOOPやFORMATはCommon Lispを使ったことがない人達にも複雑さの象徴のように語られていますが、割合にCommon Lisp以外にも輸出されています。
どちらもライブラリレベルの機能なので導入も難しくはありません。
言語仕様に入っているかどうか、ということならば、いまどきはライブラリレベルで実現できるものは言語のコアに入れず、標準ライブラリ位にまとめる所をCommon Lispでは全部標準仕様内にまとまった構成になっている、という点が特徴ですが、言語設計でそういう選択をしたので、こうなっています。
また、LOOPやFORMATはCommon Lisp以前から存在しますが、Common Lispより前のLispではライブラリとして導入されています。
コアに入っているかどうかということになると、LOOPはPython等の内包表記と機能的にはほぼ変わらないもので、ある意味先祖的なものに感じます。
内包表記の難解さに対する批評がありますがLOOPへの批評も似たものがあります(前置 vs 中置の議論の他に)
FORMATも繰り返しがあったりする所が珍しいですが、繰り返し以外では、いまどきの言語に似たようなものは多数ありますし、より多機能なものも多いです。
ちなみに、LOOPやFORMATよりいまどきの言語が標準搭載している正規表現エンジンの方が複雑だと思いますが、正規表現エンジンはCommon Lispでは標準規格にはないので、みなライブラリを利用しています。
ライブラリレベルで移植されたLOOPやFORMAT
ライブラリレベルで移植された例をざっと挙げてみましょう。
LOOP
INTERLISPのclispという環境があり、そこで中置的に書ける構文のforがMACLISP系Lispに取り入れられました。
主にMIT Lispマシングループで良く使われ、今に至ります。
Common LispのLOOPでできることは殆どINTERLISPのforで可能なのでLOOP自体が「誰かが真似したもの」でした
Common Lisp以外に移植された例
Scheme
Emacs Lisp
Clojure
等々、多数あります。
全部乗せな繰り返し構文というLOOPと似たコンセプトのものだとsrfi-42を筆頭に多数あります。
また、Common Lisp内でもLOOP代替構文というのは多数あります。
FORMAT
FORMATの出自
FORTRANのFORMATをMACLISPに導入したのが始まりのようです。
Clojure
Scheme
Emacs Lisp
全部乗せな出力構文というFORMATと似たコンセプトのものだとfmtを筆頭に結構あります。
むすび
実際の所、FORMATやLOOPは大したものでもなく、フルスペックでも大体1000行前後の実装が多いので、ひまつぶしのログラミングの題材には丁度良いと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0
「Generatorの勧め」をCommon Lispで
Posted 2018-03-25 09:11:27 GMT
ClojureにTransducers、SchemeにGenerator(SRFI-158/SRFI-121)だそうですが、Common Lispだったらseriesでしょう、ということでCommon Lisp版を書いてみました。
target1が「リスト生成→フィルタリング」、target2が「ジェネレータを使ってストリーム的に処理」するので中間コンスが少なくできる、という内容です。
今回の場合は、そっくりそのままCommon Lisp+seriesで写しとれる感じです。
下準備
;;; scheme
(define size 1000);;; cl
(ql:quickload :series)(defpackage gen
(:use :cl :series))
(in-package :gen)
(defconstant size 1000)
target1
;;; scheme
(define (target1)
(filter (lambda (x) (zero? (mod x 3)))
(map cdr
(filter (lambda (x) (odd? (car x)))
(map (lambda (x) (cons x (square x)))
(iota size))))));;; cl
(defun target1 ()
(remove-if-not (lambda (x) (zerop (mod x 3)))
(mapcar #'cdr
(remove-if-not (lambda (x) (oddp (car x)))
(mapcar (lambda (x) (cons x (expt x 2)))
(loop :for i :from 0 :repeat size :collect i))))))target2
(define (target2)
(generator->list
(gfilter (lambda (x) (zero? (mod x 3)))
(gmap cdr
(gfilter (lambda (x) (odd? (car x)))
(gmap (lambda (x) (cons x (square x)))
(make-iota-generator size)))))))(defun target2 ()
(collect
(choose-if (lambda (x) (zerop (mod x 3)))
(map-fn t
#'cdr
(choose-if (lambda (x) (oddp (car x)))
(map-fn t
(lambda (x) (cons x (expt x 2)))
(scan-range :length size)))))))target2はseriesのリーダーマクロを使えばこんな感じにも書けます。
seriesを使うならこっちが普通かもしれません。
(series::install)(defun target2/ ()
(collect
(choose-if (lambda (x) (zerop (mod x 3)))
(#Mcdr (choose-if (lambda (x) (oddp (car x)))
(#M(lambda (x) (cons x (expt x 2)))
(scan-range :length size)))))))implicit-mapを有効にすれば、更に簡潔に書けますが、ソースの字面で若干混乱しそうになるのでお勧めはしません :)
(series::install :implicit-map T)(defun target2// ()
(collect
(choose-if (lambda (x) (zerop (mod x 3)))
(cdr (choose-if (lambda (x) (oddp (car x)))
((lambda (x) (cons x (expt x 2)))
(scan-range :length size)))))))target3
ついでにdo職人による極力コンスを排したコードも参加してみます。
(defun target3 ()
(do* ((x 0 (1+ x))
(y (expt x 2) (expt x 2))
(ans (list nil))
(tem ans))
((= size x)
(cdr ans))
(when (and (oddp x) (zerop (mod y 3)))
(setf (cdr tem)
(setq tem (list y))))))比較結果
今回はタイムというより無駄なコンスを減らすことができるかがポイントのようです。
なお回数は一万回に増やしてみました。
(defparameter *count* 10000)(equal (target1) (target2))
→ T
(time
(dotimes (i *count*)
(target1)))
#||
Timing the evaluation of (dotimes (i *count*) (target1))
User time = 0.521
System time = 0.000
Elapsed time = 0.508
Allocation = 678292704 bytes
0 Page faults
Calls to %EVAL 160036
||#
(time
(dotimes (i *count*)
(target2)))
#||
Timing the evaluation of (dotimes (i *count*) (target2))
User time = 0.236
System time = 0.000
Elapsed time = 0.226
Allocation = 198294392 bytes
0 Page faults
Calls to %EVAL 160036
||#
seriesを使ったtarget2方がコンスはtarget1の約29%に縮減し、タイムも倍速くなりました。
(ちなみに、srfi-158では67%の縮減のようです。)
vs do 職人コード
do 職人のtarget3とも比較してみます。
target2と速度はあまり変わりませんが、コンスはさらに縮減できてtarget1の約5%になりました。
(equal (target1) (target3))
→ T(time
(dotimes (i *count*)
(target3)))
#||
Timing the evaluation of (dotimes (i *count*) (target3))
User time = 0.213
System time = 0.000
Elapsed time = 0.203
Allocation = 38295784 bytes
0 Page faults
Calls to %EVAL 160036
||#
といっても、途中でnとn^2のペア作ってないし卑怯!となってしまうと思うので、中間でペアを作りつつdo職人の結果を目指します。
seriesはストリーム的な書法の他に外部イテレータ的な書き方も可能で、下記のように書いてみました。
なぜこう書くかというと、ペアを作ってペアをばらすのを同一のスコープに収めてdynamic-extent指定し、コンスは無かったことにしたいからで、標準APIのストリーム的な書法ではちょっと難しいです。
(多分ストリームを二本作れば可能)
なおdynamic-extent指定をしなくても多値を使って同様の効果が得られます(がペアを作る縛りなので……)
計測してみると、do職人コードと遜色なくなりました。
(defun target4 ()
(let ((g (gatherer #'collect)))
(iterate ((x (scan-range :length size)))
(let ((x (cons x (expt x 2))))
(declare (dynamic-extent x))
(when (oddp (car x))
(let ((x (cdr x)))
(when (zerop (mod x 3))
(next-out g x))))))
(result-of g)))(equal (target1) (target4))
→ T(time
(dotimes (i *count*)
(target4)))
#|||
Timing the evaluation of (dotimes (i *count*) (target4))
User time = 0.232
System time = 0.000
Elapsed time = 0.220
Allocation = 38939848 bytes
0 Page faults
Calls to %EVAL 160036
||#
ちなみに、dynamic-extent指定を削除するとコンスはtarget1並みに増えるようです。
#||
Timing the evaluation of (dotimes (i *count*) (target4))User time = 0.244
System time = 0.000
Elapsed time = 0.231
Allocation = 198940456 bytes
0 Page faults
Calls to %EVAL 160036
||#
まとめ
遅延リスト、ストリーム、ジェネレータ辺りで何かしようと思ったらseriesも結構使えることがあります。
ただseriesは色々特殊なので、もうちょっと整理された次世代seriesがあったら良いなあという近頃です。
■
HTML generated by 3bmd in LispWorks 7.0.0
どう書く？org: ローカル変数の一覧を取得 (Common Lisp)
Posted 2018-03-18 13:46:33 GMT
久々にonjoさんのページを眺めていて、どう書く？orgの問題を解いているページに遭遇しました。
かれこれ10年以上前のことですが、そういえばこんな問題あったなあと懐しくなりました。
下記のような問題です。
どう書く？org: ローカル変数の一覧を取得
”
リフレクション系のお題の続編です。 ローカル変数の内容を取得して連想配列(ハッシュ、辞書など)に詰める コードを書いてください。Pythonで表現すると、下のコードの???部分を埋めることになります。
>>> def foo():
x = 1
y = "hello"
???
return result
>>> foo()
{'y': 'hello', 'x': 1}
”
なお、どう書く？orgは残念ながらアダルトサイトと化してしまったようなのでリンクはarchive.orgです。
Lisp方言の他の方々の回答は、基本構文に仕込みを入れて、Pythonでいうlocalsみたいなものをサポート、という感じです。
自分は、この問題は解いたことがなかったので、色々考えてみました。
Common Lispにおいてローカル変数とは
お題はPythonが念頭にあるようですが、Lisp-1なPythonならローカルのスコープに漂っているのは変数位のものです。
しかし、Lisp-2の権化たるCommon Lispだと、関数、マクロ、シンボルマクロ、スペシャル変数等々がローカルスコープに存在しうります。
実際的にコードウォーキングして何かをする場合、ブロック、GOタグ等を含めていじること多いので、変数だけ取得できても、そんなに嬉しくない気はしますが、それはさておき解答を考えてみます。
解答その一 (実際的に考える)
実際の所、実行時にスコープ内のローカル変数名の一覧を取得したいことというのは殆どありません。
また、遅くなっても良いのだったら、別に言語のスコープのコンテクストをいじらなくても、連想配列等でエミュレートできそうです。
とりあえず、Common Lispには、実行時に名前で変数をアクセスする仕組みとしてスペシャル変数があるので、そういう時はスペシャル変数を使うのが良いだろうということで、こんな感じに書いてみました。
(defun locals () nil)(defmacro progx ((&rest binds) &body body)
`(progv ',(mapcar #'car binds)
(list ,@(mapcar #'cadr binds))
(flet ((locals ()
(append (list ,@(mapcar (lambda (b)
`(cons (quote ,(car b))
,(cadr b)))
binds))
(locals))))
,@body)))
(defun foo (&aux result)
(progx ((outer 42))
(progx ((x 1)
(y "hello"))
(setq result (locals))
result)))(foo)
→ ((x . 1) (y . "hello") (outer . 42))
上記のprogxは、実行時の変数結合を実現するprogvをラップしたもので、ボディ内部のlocalsの実行で指定された変数名が取得できます。
スペシャル変数のアクセスはそこまで遅くないので、もし実際的に必要なことがあれば、こういうものでまかなえるのではないでしょうか。
その二 (定義時に処理する)
onjoさんの解答がこちらの系統ですが、onjoさんはAllegro CLのインタプリタ動作時のみ対応とのことでした。
しかし、実行時に外から飛び込んでくるレキシカル変数名というのは考慮しなくても良さそうなのと、外から飛び込んでくるスペシャル変数名は、上記progxのようなもので別途対応すれば良いだろうということで、定義時(マクロ展開時)に確定した情報を取得できれば良しという方針でシンプルに書いてみました。
#+lispworks
(defun get-local-variables (env)
(mapcar #'compiler::venv-name (compiler::environment-venv env)))#+sbcl
(defun get-local-variables (env)
(mapcar #'car (sb-c::lexenv-vars env)))
#+allegro
(defun get-local-variables (env)
(let* ((base (sys::augmentable-compilation-environment-base env))
#+(:version= 8)
(vartab (sys::augmentable-environment-variable-hashtable base))
#+(:version>= 9)
(vartab (sys::ha$h-table-ht
(sys::augmentable-environment-variable-hashtable base))))
(loop :for var :being :the :hash-keys :of vartab
:when (typep (sys:variable-information var env)
'(member :lexical :special))
:collect var)))
(defmacro locals (&environment env)
`(list ,@(mapcar (lambda (v)
`(list ',v ,v))
(get-local-variables env))))
肝は、ローカル変数の一覧が取れるかどうかなのですが、Clozure CLでは取得の方法が分からず対応していません。
ローカル変数の一覧が取れる処理系であれば同様の方法で取得できるかなと思います。
試してみる
こんな感じになります。
(defun foo (&aux result)
(let ((outer 42))
(declare (special outer))
(flet ((bar ()
(let ((x 1)
(y "hello"))
(setq result (locals))
result)))
(bar))))
→ ((y "hello") (x 1) (outer 42) (result nil))また、変数は宣言してから使うことになるので、Pythonと違ってresultも計上されることになりますし、ローカル変数外側のスコープものも見えます。
ちなみに、Pythonで確認してみたところ、外のブロックのものは取得しない様子。
def foo():
outer = 42
def bar():
x = 1
y = "hello"
result = locals()
return result
return bar()→ {'y': 'hello', 'x': 1}
しかし、一番内側のブロックで変数を使えば見えるようです。
どうも、中途半端なような。
def foo():
outer = 42
def bar():
x = 1
y = "hello"
z = outer
result = locals()
return result
return bar()→ {'y': 'hello', 'x': 1, 'z': 42, 'outer': 42}
まとめ
どう書くorgのページでも議論されていましたが、処理系がデバッグ情報として変数名を含める際にこういう機能が必要になることが多いと思われますが、ユーザーが触って何か有益な処理をするというのはあまり無さそうです。
なお、ご存知の通り、Common Lispでは対話的なデバッガの機能が充実しているので、ローカルな変数名等は大抵見えたり、変更したりもできます。
■
HTML generated by 3bmd in LispWorks 7.0.0
RMSはCommon Lispの言語仕様をとりまとめた主要人物ではない
Posted 2018-03-10 07:44:34 GMT
こんにちはCommon Lispポリスメンです。
最近だいぶ忘れられてきてる気がするけど、rmsは Common Lisp の言語仕様をとりまとめた主要4人のうちの一人で、GNUをプロジェクト立ち上げて GNU emacs と gcc と gdb の最初のバージョンを全部一人で書いた偉人ですからね…
— SODA Noriyuki (@n_soda) 2018年3月9日
RMSはとても偉大ですが、Common Lisp仕様の議論には参加してるものの、主要人物ではありませんでした。
ちなみにCommon Lisp仕様の議論には何十人もの人が参加しています。
また、主要人物は4人ではなく、5人でした。
The core group eventually became the “authors” of CLtL I: Guy Steele, Scott Fahlman, David Moon, Daniel Weinreb, and Richard Gabriel. This group shouldered the responsibility for producing the language specification document and conducting its review. The self-adopted name for the group was the “Quinquevirate” or, more informally, the “Gang of Five”.
また、ANSI Common Lisp規格策定のX3J13のメンバーでもありません。
おそらくですが、RMSとGLSが混ざってしまったのではないでしょうか(LispとEmacsあたりで)
RMSが議論に参加している様子は、仕様策定メーリングリストで眺めることができますので、ご興味があればどうぞ。
また、Common Lisp(1984)の謝辞にも登場しています。
その他おまけ
RMSが書いたっぽいLispコードの例
- コードウォーカー:qcluke.lisp
- FORMAT代替ユーティリティ:output.lisp(開発動機はFORMATがLispっぽくないから)
■
HTML generated by 3bmd in LispWorks 7.0.0
Common Lispのeval-whenとコンパイラかインタプリタ実装かは別のレイヤーの話
Posted 2018-03-07 20:02:22 GMT
先日Twitterでこんなやりとりを目にしました
ところがどっこいLisp
— わさびず (@___yuni) 2018年3月2日
たしかに太古のMACLISPや、Franz Lispでは、変数の結合がダイナミックだったりして、コンパイラ(静的に決まることが多かった)かインタプリタ(基本動的)かで挙動が変わることが悩みのタネだったことがありました。
しかし……Common Lispではコンパイラかインタプリタ実装かで実行に差異はない
はい、残念ながらeval-whenというのがあって、コンパイラとインタプリタが存在して違う操作的意味を持つことが前提になってます
— わさびず (@___yuni) 2018年3月2日
eval-whenというからにはLispが指しているのはCommon Lispだと思いますが、Common Lispでは、評価器がコンパイラかインタプリタ実装かで違いはでないこと、と規定されています。
また、プログラムがどちらの方式で実行されているか知る手立てもありません。
evaluation n. a model whereby forms are executed , returning zero or more values.
Such execution might be implemented directly in one step by an interpreter or in two
steps by first compiling the form and then executing the compiled code; this choice is
dependent both on context and the nature of the implementation, but in any case is
not in general detectable by any program. The evaluation model is designed in such a
way that a conforming implementation might legitimately have only a compiler and
no interpreter, or vice versa. See Section 3.1.2 (The Evaluation Model).Common Lispがするコンパイルと実装戦略は別
じゃあ、Common Lispのcompileとかcompile-fileはどうなるんだ、と思うかもしれないですが、Common Lispが規定するコンパイルプロセスは、評価器の実装戦略とは別のレイヤーの話です。
以下、ややこしいのでコンパイルプロセスの方をコンパイルと書きます。
Minimal Compilationというのが定められていますが、インタプリタのみの処理系でも、コンパイルしてロードして、というのは可能で、その場合にはコンパイルによってマクロ展開等の前処理的なものを省いたものを解釈していくことになると思われます(多分)
また逆に、evalが即ちインタプリタということもなく、フォームの一塊のツリーをコンパイルしてから処理しても問題ありません。
Minimal compilation is defined as follows:
• All compiler macro calls appearing in the source code being compiled are expanded, if at
all, at compile time; they will not be expanded at run time.
• All macro and symbol macro calls appearing in the source code being compiled are
expanded at compile time in such a way that they will not be expanded again at run
time. macrolet and symbol-macrolet are effectively replaced by forms corresponding to
their bodies in which calls to macros are replaced by their expansions.
• The first argument in a load-time-value form in source code processed by compile
is evaluated at compile time; in source code processed by compile-file , the compiler
arranges for it to be evaluated at load time. In either case, the result of the evaluation is
remembered and used later as the value of the load-time-value form at execution time.eval-whenとは
eval-whenは、主に処理が複数に分かれてしまう(ファイルをコンパイルしてロードする等)場合に生じる問題を解消するためのもので、コンパイル中にコンパイル中に定義した関数を使いたいとか、コンパイル済みのファイルをロードする場合に特定の仕事をさせたい等々のことに利用します。
あーーーーそうかーーーー（Emacs Lispの eval-when-compile は認識してたなあ）
— gfn (@bd_gfngfn) 2018年3月2日
Emacs Lispのeval-when-compileも似たようなものだと思いますが、脚注のコメントによると、Common Lispの#.(リード時評価)により近いそうです。
用途としてはCommon Lispと同じではないでしょうか。インタプリタ実装でもコンパイルは可能なので、Emacs Lispは、100%インタプリタ実装のCommon Lispに近い感じなのかもしれません。
他の方々からの指摘
うーん、そうなのかなー？eval-whenの使いどころは分からないけど、Common Lispはインタープリタかコンパイラかは言語仕様的には規定しないって明示されていた気がする。例えば、即座にコンパイルしてインタープリタを持たない実装もOKなはず
— Miura Hideki (@miura1729) 2018年3月3日
上記で説明したように、挙動は変わないことになっています。
なるほど、意味が分かりました。eval-whenでコンパイル時に何か行えば実装がコンパイラかインタープリタかで挙動を変えることが出来るから同一セマンティクスじゃなくなりますね。すっきりしました、ありがとうございます。
— Miura Hideki (@miura1729) 2018年3月3日
上記で説明したように、eval-whenと実装戦略は別のレイヤーで、これらの組み合わせがコードの意味を変えることはありません。
まとめ
Common Lispではコンパイラかインタプリタ実装かで実行に差異はない、と書きましたが、これは過去のLispでの問題を解決する歴史の上に成り立ったものでした。
Common Lispの歴史の中でも、ANSI規格以前のCLtL1では、*applyhook*、*evalhook*、compiler-let等、コンパイラ/インタプリタ動作で整合性が取れなくなる/取るのが難しい機能が散見されましたが、これらはANSI規格として煮詰められる際に廃止となっていたりします。
また、現代のCSの意味論からすると不思議なこともあると思いますが、CSの意味論が洗練/確立する前からLispのコンパイラ/インタプリタは存在します。
長い歴史の中で、互いに影響しあったかもしれませんし、同じような結果になったとしても道程は全然違うものかもしれません。
コンパイラ……インタプリタ……コンパイラがコンパイル……と書いてる間に段々良く分からなくなってきたので、間違いがあったらご指摘よろしくお願いします。
ちなみに何故Twitterの議論には参加していないのかというと、自分は鍵アカウントの為で、ブログで失礼しました。
■
HTML generated by 3bmd in LispWorks 7.0.0
マクロ展開コードの副作用から起きる問題の特別に汚い例が気になる
Posted 2018-01-21 09:01:25 GMT
On Lispの10.3 マクロ展開関数の副作用には、
MillerとBensonのLisp Style and Designは 展開コードの副作用から起きる問題の特別に汚い例に言及している． Common Lispでは...
とあります。
恐らく、「特別に汚い例に言及している．」の後は、Lisp Style and Designが言及している内容を具体的に紹介しているのだとは思いますが、いまいち文の繋がりが良くなく思え、言及しているという紹介のみで、以降は全く別の話という可能性も無くはないと思えてきてしまったので、実際にLisp Style and Designでは何が書かれていたのか確認してみました。
ネタ元
Lisp Style and Designでは、マクロの展開時の問題について解説していますが、恐らく、4.2.5.2 Problems to Avoid When Writing Macros(P.85)のようです。
この段落では、主にマクロ展開時に副作用を使うと、どういう悪い結果が齎されるかについて、具体例を挙げて解説していますが、締めに&rest・&bodyのリストの破壊的変更が解説されています。
ということで、On Lisp 10.3章の「言及している」から章末までは、Lisp Style and Designでの解説を元ネタにしてます、ということだったようです。
ちなみに、On Lisp 10.3章では、副作用の例として、マクロ展開時に変数を更新することについてを取り上げていますが、Lisp Style and Designでは、変数のspecial宣言を取り上げていて、On Lispでinternの問題が追加になった以外は、両書ともほぼ同じ問題を紹介していたようです。
■
HTML generated by 3bmd in LispWorks 7.0.0
マクロに付くコンパイラマクロの使い道
Posted 2018-01-15 18:11:35 GMT
コンパイラマクロは関数だけでなくマクロにも定義できます。
HyperSpecのdefine-compiler-macroの項目にも明記されているのですが、一体どういう所で使うのかと思っていました。
コンパイラマクロの使い方としては、基本的にセマンティクスが変わらないことが絶対条件で、あとは何らかの効率が良くなるようなコード変換をすることになるんだと思います。
マクロでこういうパターンはどういう場合かを考えてみましたが、TAOのforみたいな場合に効率的な処理に展開できそうなので、ちょっと試してみました。
なお、マクロにコンパイラマクロを定義して、マクロなのにfuncallが効くように見せ掛けるテクニックを目にしたことがありますが、これはセマンティクスが変わってしまうのでNGかなと思っています。
TAOのfor
TAOのマニュアルによると、forは、
形式 : for var list form1 form2 ...
form1 form2 ... を var を使って順に実行する。 var は list の各要素に
逐次束縛されたものである。 form1 form2 ... は list の長さと同じ回数評価
される。 nil を返す。とあって殆どdolistと同じ挙動なのですが、indexというSRFI-1のiotaのような関数と組み合せて使う場合、実際には数値リストが生成されないという説明があります。
(index 0 10)
→ (0 1 2 3 4 5 6 7 8 9 10) (let ((ans nil))
(for i (index 0 10) (push i ans))
ans)
→ (10 9 8 7 6 5 4 3 2 1 0)
恐らく実際のTAOもマクロ展開のパターンマッチで展開を変えているんだと思いますが、こういうケースのマクロ展開にコンパイラマクロが使えそうです。
とりあえず、ベースの関数とマクロを定義します。
(defun index (start end &optional (step 1))
(if (plusp step)
(loop :for i :from start :upto end :by step :collect i)
(loop :for i :from start :downto end :by (- step) :collect i)))(defmacro for (var list &body body)
`(dolist (,var ,list nil)
,@body))
コンパイラマクロで中間リストの生成を無くす
そしてコンパイラマクロを定義します。
下記では、無駄にメソッドを使っていますが、こういう場合には嵌るかなと思って試してみました。
メソッドディスパッチでindexだけでなく、iotaにも対応してみています。
(define-compiler-macro for (&whole whole var list &body body)
(for-cm-expander (car list) var list body whole))(defgeneric for-cm-expander (fn var list body whole)
(:method (fn var list body whole)
(declare (ignore fn var list body))
whole))
(defmethod for-cm-expander ((fn (eql 'index)) var list body whole)
(declare (ignore whole))
(destructuring-bind (index start end &optional (step 1 stepp))
list
(declare (ignore index))
(if stepp
`(if (plusp ,step)
(loop :for ,var :from ,start :upto ,end :by ,step
:do (progn ,@body))
(loop :for ,var :from ,start :downto ,end :by (- ,step)
:do (progn ,@body)))
`(loop :for ,var :from ,start :upto ,end
:do (progn ,@body)))))
(defmethod for-cm-expander ((fn (eql 'srfi-1:iota)) var list body whole)
(declare (ignore whole))
(destructuring-bind (iota count &optional (start 0) (step 1))
list
(declare (ignore iota))
`(loop :for ,var :from ,start :repeat ,count :by ,step
:do (progn ,@body))))
こういう定義にすると、コンパイル時にはこういう展開になります。
(compiler-macroexpand '(for i (index 10 20) (print i)))
==>
(loop :for i :from 10 :upto 20 :do (progn (print i))) (compiler-macroexpand '(for i (srfi-1:iota 10) (print i)))
==>
(loop :for i :from 0 :repeat 10 :by 1 :do (progn (print i)))
決め打ちのパターンから外れれば、リストを回す通常の処理になります。
(compiler-macroexpand '(for i (cons -1 (index 0 10)) (print i)))
==>
(for i (cons -1 (index 0 10)) (print i)) むすび
define-compiler-macroでマクロにコンパイラマクロを定義できるようにした経緯からユースケースを知りたかったのですが、過去のメーリングリスト等からは探し出せませんでした。
何か他のユースケースがあれば是非とも知りたいです。
■
HTML generated by 3bmd in LispWorks 7.0.0
LispWorks 7.1 購入への道(3) — バグ報告2件
Posted 2018-01-14 09:15:07 GMT
LispWorks 7.1を試用していて2件程バグっぽい挙動に遭遇していました。
折角試用させて貰ったので、何かバグ的なものは報告しておきたいところなので期間最終日に報告。
7.1は関数のボディで点対リストを受けつける
具体的な再現コードにすると
(defun foo (x) x . a)
→ foo(compile nil (lambda (x) x . a))
→ #<Function 15 406003A054>
NIL
NIL
というのが通ってしまいます。
LW 7.0では、
In a call to length of (x . a), tail a is not a LIST.
というエラーになりますが、LispWorks以外の大抵の処理系も同様のエラーとします。
7.1では、点対リストを許容するようになったのかとも思えますが、
(compile nil (lambda (x) . a))
→ Cannot take CDR of A.こういうのは通らないので一貫性がない様子。
UTF-8のエンコーディング設定で起動時にエラーになる
もう一点、LispWorks 7.0を利用していてバグじゃないかと思いつつも適当なワークアラウンドで回避できていたのですっかり忘れていたことがありました。
具体的には、UTF-8の設定時に起動でコケるというちょっと嫌な感じのもの。
どうやらバイナリのファイル(スプラッシュ画像)をUTF-8で開こうとしてエラーになるらしいので、ファイルのエンコーディング判定関数で画像ファイルは迂回するようにしていましたが、これが7.1でも発生する様子。
;;; 回避コード
(defun utf-8-file-encoding (pathname ef-spec buffer length)
(declare (ignore buffer length))
(if (assoc (pathname-type pathname) graphics-ports::*file-types-to-image-types*
:test #'equalp)
'(:latin-1)
(system:merge-ef-specs ef-spec '(:utf-8 :use-replacement t))))(setq system:*file-encoding-detection-algorithm*
'(utf-8-file-encoding))
報告を作成するためにちょっと追い掛けてみましたが、capi-gtk-library::put-image-data-in-fileでエラーになるらしいので、この関数のトレース結果を添付しました。
報告してみた
最終日に報告してみたところ、UTF-8の方はバグだったらしく二日後にプライベートパッチが届きました。
なんとパッチが出るとは想定していなかった。試用期間は終了しているのでパッチが試せないという……。
パッチの名前が、put-image-data-in-file.64ufaslなので、やはり報告した、capi-gtk-library::put-image-data-in-fileが問題のようです。
もったいないので、とりあえず駄目元で7.0で読み込ませてみましたが、faslに互換性がないと警告がでるものの、無視して続行可能なので試したら、7.0でも機能するようです。
ちょっと深追いして、パッチ適用前後のcapi-gtk-library::put-image-data-in-fileを比較してみると、修正前のものは、バイナリの一時ファイルを作成するのにsys:make-temp-fileというテキストの一時ファイルを作成する関数を呼んでいたため、エンコーディングの問題が発生していたようです。
修正では、sys:make-temp-fileの下請けであるsys::open-temp-fileを使ってファイルを(unsigned-byte 8)で開くようにした様子。
大抵のユーザーはlatin-1で使っていたから遭遇しなかった問題なのか、なんなのか。
とりあえず、バイナリファイルの開き方が悪かったということで、エンコーディング周りがバグってるわけではない様子なので良かったです。
ちなみに7.0で強制的に読み込ませるのには、
(handler-bind ((fasl-error #'continue))
(scm:require-private-patch "put-image-data-in-file" :capi-gtk))としています。
7.0用のパッチが貰えるなら、貰った方が良いのかもしれない。
試しにdisassembleの内容からコードを推測しつつ自作しててみましたが、下記と等価なようです。
(コンパイルオプションを設定すればdisassembleの結果が同じになる)
(in-package :cg-lib)(declaim (optimize (safety 3)
(speed 1)
(float 1)
(sys:interruptible 0)
(compilation-speed 1)
(debug 2)
(hcl:fixnum-safety 3)))
(defun put-image-data-in-file (image-data)
(destructuring-bind (file-type . data)
image-data
(let ((out (sys::open-temp-file :file-type file-type
:element-type '(unsigned-byte 8)
:external-format :latin-1)))
(write-sequence data out)
(close out)
(namestring out))))
このコードを
(let ((source-debugging-on-p (source-debugging-on-p)))
(toggle-source-debugging nil)
(compile-file "put-image-data-in-file.lisp" :debug-info nil)
(toggle-source-debugging source-debugging-on-p))のような感じでコンパイルすれば、大体提供されているパッチファイルと同じになるようです。
LispWorks 7.0のパッチが入手できない場合は、最悪これでも良いかもしれません。
もう一つのボディが点対リストを許容する件については、一週間後位に回答があり、次期バージョンで善処したいということでした。
むすび
試用期間のバグ報告は、パッチが期間内に試せるように早めに報告しよう。
■
HTML generated by 3bmd in LispWorks 7.0.0
LispWorks 7.1 購入への道(2) — Common Prologを試す
Posted 2018-01-10 18:01:30 GMT
LispWorksでは、Enterprise版でしか使えない機能はいくつかありますが、中でも自分はKnowledgeWorksに興味があったので、まずはこれを試してみたいところ。
KnowledgeWorksは、Common Lispで構成された古き良き知識ベースのシステムで、主に後ろ向き推論のPrologと、前向き推論のOPS5が合体したようなシステムです。
1980年代後半から90年代前半の商用のLispシステムでは、エキスパートシステム作成用にOPS5やProlog拡張が付属することが多かったようで、こういう構成は案外定番の構成だった様子。
(ちなみに、Prologの処理系でも前向き推論の拡張等は良く付属していたようです。)
Prolog部分は、Common Prologと呼ばれていて、これ単体でも使えます。
ということで、このブログでは毎度お馴染のZebraベンチを書いてみました。
Common PrologでZebra ベンチ
;;;; -*- Mode: common-lisp; Syntax: Common-Lisp -*-
(declaim (optimize (speed 3) (safety 0) (compilation-speed 0)
(debug 0)))(eval-when (:compile-toplevel :load-toplevel :execute)
(require "prolog"))
(defpackage :clog-zebra (:use :cl :clog))
(in-package :clog-zebra)
(defrel nextto
((nextto ?x ?y ?list) (iright ?x ?y ?list))
((nextto ?x ?y ?list) (iright ?y ?x ?list)))
(defrel iright
((iright ?left ?right (?left ?right . ?rest)))
((iright ?left ?right (?x . ?rest))
(iright ?left ?right ?rest)))
(defrel zebra
((zebra ?h ?w ?z)
;; Each house is of the form:
;; (house nationality pet cigarette drink house-color)
(= ?h ((house norwegian ? ? ? ?) ;1,10
?
(house ? ? ? milk ?) ? ?)) ; 9
(member (house englishman ? ? ? red) ?h) ; 2
(member (house spaniard dog ? ? ?) ?h) ; 3
(member (house ? ? ? coffee green) ?h) ; 4
(member (house ukrainian ? ? tea ?) ?h) ; 5
(iright (house ? ? ? ? ivory) ; 6
(house ? ? ? ? green) ?h)
(member (house ? snails winston ? ?) ?h) ; 7
(member (house ? ? kools ? yellow) ?h) ; 8
(nextto (house ? ? chesterfield ? ?) ;11
(house ? fox ? ? ?) ?h)
(nextto (house ? ? kools ? ?) ;12
(house ? horse ? ? ?) ?h)
(member (house ? ? luckystrike oj ?) ?h) ;13
(member (house japanese ? parliaments ? ?) ?h) ;14
(nextto (house norwegian ? ? ? ?) ;15
(house ? ? ? ? blue) ?h)
(member (house ?w ? ? water ?) ?h) ;Q1
(member (house ?z zebra ? ? ?) ?h) ;Q2
))
;; (logic '(zebra ?h ?w ?z) :return-type :fill)
(defun zebra-benchmark (&optional (n 1000))
(declare (optimize (speed 3) (safety 0)))
(let (rt0 rt1)
(time (loop initially (setf rt0 (get-internal-run-time))
repeat n do (logic '(zebra ?h ?w ?z) :return-type :fill)
finally (setf rt1 (get-internal-run-time))))
(destructuring-bind (houses water-drinker zebra-owner)
(logic '(zebra ?houses ?water-drinker ?zebra-owner)
:return-type :bag
:bag-exp '(?houses ?water-drinker ?zebra-owner))
(values (/ (* n 12825) (/ (- rt1 rt0) 1000.0)) ; real time
; is milliseconds
zebra-owner water-drinker houses))))
CL-USER 1 > (clog-zebra::zebra-benchmark)
Timing the evaluation of (LOOP CLOG-ZEBRA::INITIALLY (SETF CLOG-ZEBRA::RT0 (GET-INTERNAL-RUN-TIME)) COMMON-PROLOG:REPEAT CLOG-ZEBRA::N DO (COMMON-PROLOG:LOGIC (QUOTE (CLOG-ZEBRA::ZEBRA CLOG-ZEBRA::?H CLOG-ZEBRA::?W CLOG-ZEBRA::?Z)) :RETURN-TYPE :FILL) CLOG-ZEBRA::FINALLY (SETF CLOG-ZEBRA::RT1 (GET-INTERNAL-RUN-TIME)))User time = 2.888
System time = 0.000
Elapsed time = 2.868
Allocation = 447980280 bytes
0 Page faults
4440789.5
CLOG-ZEBRA::JAPANESE
CLOG-ZEBRA::NORWEGIAN
((CLOG-ZEBRA::HOUSE CLOG-ZEBRA::NORWEGIAN CLOG-ZEBRA::FOX CLOG-ZEBRA::KOOLS CLOG-ZEBRA::WATER CLOG-ZEBRA::YELLOW) (CLOG-ZEBRA::HOUSE CLOG-ZEBRA::UKRAINIAN CLOG-ZEBRA::HORSE CLOG-ZEBRA::CHESTERFIELD CLOG-ZEBRA::TEA CLOG-ZEBRA::BLUE) (CLOG-ZEBRA::HOUSE CLOG-ZEBRA::ENGLISHMAN CLOG-ZEBRA::SNAILS CLOG-ZEBRA::WINSTON CLOG-ZEBRA::MILK CLOG-ZEBRA::RED) (CLOG-ZEBRA::HOUSE CLOG-ZEBRA::SPANIARD CLOG-ZEBRA::DOG CLOG-ZEBRA::LUCKYSTRIKE CLOG-ZEBRA::OJ CLOG-ZEBRA::IVORY) (CLOG-ZEBRA::HOUSE CLOG-ZEBRA::JAPANESE CLOG-ZEBRA::ZEBRA CLOG-ZEBRA::PARLIAMENTS CLOG-ZEBRA::COFFEE CLOG-ZEBRA::GREEN))
以前、Common Lispの埋め込みPrologを試してみる: Zebraベンチ篇で、ベンチ対決した結果と並べるとこんな感じです。
| 順位 | 処理系 | タイム(秒) | 比 |
|---|---|---|---|
| 1 | AZ-Prolog | 0.710 | 1 |
| 2 | Allegro Prolog | 0.852 | 1.2 |
| 3 | SWI-Prolog | 1.422 | 2 |
| 4 | Common Prolog | 2.888 | 4 |
| 5 | PAIProlog | 11.712 | 16.5 |
| 6 | Uranus | 51.080 | 71.9 |
むすび
PAIPrologの約6倍速く、Allegro Prologの3.4倍遅く、最速のAZ-Prologからは約4倍遅いという結果になりました。
Allegro Prologが謎の速さをみせていますが、Common Prolog(KnowledeWorks)は多機能で、開発環境もリッチですし、全体的なバランスとしては、なかなか良いのではと感じています。
関連エントリー
- LispWorks 7.1 購入への道(1)
- LispWorks 7購入への道(5) ─ 購入
- LispWorks 7購入への道(4) ─ 試用期間の終わりとアンケート回答
- LispWorks 7購入への道(3) ─ Java連携を試す
- LispWorks 7購入への道(2) ─ StumpWMをLWで
- LispWorks 7購入への道(1)
■
HTML generated by 3bmd in LispWorks 7.0.0
LispWorks 7.1 購入への道(1)
Posted 2018-01-08 16:48:54 GMT
昨年末の11月13日、LispWorks 7.1が発表されました。
LispWorks 7.0が2015-05-05の発表だったので、約二年半ぶりのバージョンアップです。
LispWorks 7.0を使い始めて二年ちょっと経過しましたが、毎日使っているとはいえ、あまり使い倒した感もないため、このまま7.0で行くか、とりあえず、7.1に上げるか悩ましい所ですが、一ヶ月試用できるサービスがあるので、出てすぐの11月17日に試用を申し込んでみることにしました。
お察しの通り、もうとっくに試用期間も終わってしまっているのですが、7.1について何一つブログに書いていなかったので何回かに分けて書いてみます。
試用の申し込み
試用については、二年前のエントリーと全く同じ手順でしたが、既存ユーザーだからか毎度ありがとうというような返事が来ました。
前回は、HobbyistDVでの試用でしたが、今回は、折角なので、HobbiestとEnterpriseの二種で申し込んでみました。
格が違うとはいえ、ライセンスキーが違うのみで、配布されているファイルは全バージョン共通のようです。
ライセンスキーが届いたので、ファイルをダウンロードし、早速、以前報告したバグがどうなっているか確認してみました。
7.0でのバグは修正されたのか
さて、7.0を使っていて、何度かバグ報告をしてパッチを貰ったりはしていましたが、修正はされているのかが気になりますので、早速確認。
一応、リリースノートには目を通しましたが、そんなに細かいものまで書いてはいないようです。
シンボルのバグ: 修正済み
7.0では、UTF-8環境で、(eq '資料コード '資料コード) → nilだったりしたので、報告してプライベートパッチを貰ったりしていましたが、治っていました。これは良かった。
しかし、これ7.0で公開パッチ出して欲しかった所ですなあ。
libssl 1.1の読み込みに失敗する: 対応済み
libssl 1.1を読み込ませる場合に明示に指定しないといけない件で問い合わせましたが、次バージョンで対応とのことでした。
リリースノートにもある通り対応されていたので良かったです。
システムの内部関数で型宣言が合ってないものがある: 据置き
sys::find-external-symbolの型宣言が合ってないのでコンパイルするとエラーになる件でしたが、内部関数は使うな、という回答を貰っていました。
確認した所こちらは据置き。
プロダクション用コンパイルのオプションだと無視しちゃうから気にしてない、とかそういう感じだとは思うけど、いやでも変だと思うんだよなあ。
その2に続く
関連エントリー
- LispWorks 7購入への道(5) ─ 購入
- LispWorks 7購入への道(4) ─ 試用期間の終わりとアンケート回答
- LispWorks 7購入への道(3) ─ Java連携を試す
- LispWorks 7購入への道(2) ─ StumpWMをLWで
- LispWorks 7購入への道(1)
■
HTML generated by 3bmd in LispWorks 7.0.0
逆引きCommon Lisp/Scheme・Common Lisp Users JPサイトを移動しました
Posted 2018-01-05 21:59:04 GMT
立ち上げて早十年の逆引きCommon Lisp/Schemeサイトですが、Shibuya.lisp時代には長期間サイトが落ちていてもなかなか復旧されないため個人のサーバーに移動してみたり転々としています。
先日、再び新しいサーバーに移動することになったので、このタイミングでLispの情報集積サイトである lisphub.jpに移動することにしました。
さらについでで、2010年に立ち上げた Common Lisp Users JP も移動し、若干URLに統一感を持たせる感じで一緒のサイトに設置しました。
- Common Lisp Users JP : http://lisphub.jp/common-lisp/users/
- 逆引きCommon Lisp : http://lisphub.jp/common-lisp/cookbook/
- 逆引きScheme : http://lisphub.jp/scheme/cookbook/
旧URLからは301でリダイレクトされるのでリンクから辿ってくるぶんには使い勝手に変化はありません。
ちなみに、 lisphub.jp ですが、最低10年は保たれるLispのハブサイトを目指して、2013年に立ち上げましたが、広報活動で色々失敗しており、2023年までドメインだけは確保しているという悲しい状況なので今後は活用していきたい所存です……。
■
HTML generated by 3bmd in LispWorks 7.0.0
2017年振り返り
Posted 2018-01-03 10:24:45 GMT
毎年振り返りのまとめを書いていたのですが、ホストしているサーバーの移行をしていて、2017年中に間に合いませんでした。
このブログを配信しているteepeedee2が上手く動かせなかったというのが主な理由ですが、teepeedee2は毎度ながら手強い……。
Lisp的進捗
ブログ
ですます調をやめて、である調にしましたが、どうもしっくり来ないので、今年からはまた、ですます調に戻します……。
である調でも書けるようになってみたかったのですが、どうも過剰に偉そうな雰囲気になってしまうという。
学習
毎年、Advent Calendarで少しだけ無理をして何かを調べて書いていましたが、2017は気力がないのでやめてしまいました。
しかし、やっぱり何かやっておけば良かったなあという思いが残る……。
2018年はがんばりましょう。
LispWorks
LispWorks 7.1が2017年11月に登場し、自分も試用を申し込んで、それなりに7.1の知見は貯まりましたが、全然記事にしていません。
7.0からHobbyist Edition($750)が登場し以前よりは、身近になった気はしますが……。
去年読んでる途中と報告した、LispWorks User Guide and Reference Manualとか、CAPI User Guide and Reference Manualは未だに読み終えていません。
仕様とかマニュアルを読み通すって結構大変なんですよねえ……。 なんかしらちょっとは書きたいと思います。
来年やってみたいこと
昨年の目標であった、
- 積極的にLisp本の積読本を読んで記事にして行きたい
- LispWorksのマニュアル全部を通読したい
- VMS/VAXのエミュレータでVAX LISPを動かしたい
- Lisp組み込み系Prologを系統立てて比較してみたい
- Shenをもうちょっと触りたい
- ヒューイット先生について調べる
は、VAX LISPがライセンスの関係で動かなかったことがはっきりした以外は何も進捗がないですね。
いやあ、時間がない訳では全くないのですが……。
やりたいことは大して変化なしなので、継続としたいと思います。
今年は、もうちょっと活動的になりたいですね。
過去のまとめ
- #: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
マクロ禁止令
Posted 2017-12-13 11:52:38 GMT
Lisp Advent Calendar 2017 十三目です。
空きがあったのでネタで埋めようと思い書きました。
十三目書いてたのに!という方は、すいませんが、まだ空きがあるので他の日を埋めてください。
マクロが禁止されたらどうなるの
良くも悪くも誤解が多いLispマクロ。
Lispマクロに心酔するあまり過大評価する人もいれば、過大評価する人をみて過小評価に転ずる人もいる始末ですが、基本的にはコードを生成するだけの機能です。
そんなマクロですが、Common Lispで仮に禁止されたらどうやって生きていったら良いのか考えてみました。
(ちなみに話を簡単にするためにローカルマクロのことは考えないことにします。)
defmacroは何をしているの
Common Lispのdefmacroで定義するものは、リストを引数にして、リストを返すという関数です。
しかし、評価の前に再帰的にマクロを展開するフェイズがあり、そこで展開関数が実行されるので、まるで関数評価のような感じで使うことができます。
例えば、下記のようなコードでloopの展開関数だけ実行することも可能です。
(funcall (macro-function 'loop)
'(loop :for i :from 0 :repeat 10 :collect i)
nil)関数だけでdefmacroのようなことをしてみる
例としてdotimesのようなものを考えてみましょう
'(dotimes (i 10) (princ i))のようなリストを
'(prog ((#:|limit17589| 10) (i 0))
"=>"
(cond ((<= #:|limit17589| i) (return (let ((i nil)) nil))))
(progn (princ i))
(incf i)
(go "=>"))のようなリストに変形すれば良いので、
(defun mydotimes (form &optional env)
(declare (ignore env))
(destructuring-bind (_ (var limit &optional result) &body body)
form
(declare (ignore _))
(let ((limvar (gensym "limit"))
(tag (gensym "=>")))
`(prog ((,limvar ,limit)
(,var 0))
,tag (cond ((<= ,limvar ,var)
(return (let ((,var nil)) ,result))))
(progn ,@body)
(incf ,var)
(go ,tag)))))のような関数を書けるでしょう。
(まあ、結局の所マクロを書く作法が身に付いていないと、こういう関数も書けないのですがそれは一旦忘れましょう)
これで、下記のように書けます。
(with-output-to-string (out)
(declare (special out))
(eval (mydotimes
`(mydotimes (i 3)
,(mydotimes '(mydotimes (j 3)
(princ i out)
(princ j out)))))))
→ "000102101112202122" やはりマクロ展開と実行コードを混ぜて書かないといけないので、ごちゃごちゃしてしまいます。
別個にマクロ展開関数を用意して、オペレーターが定義したマクロかどうかを確認しつつ展開するようにすれば、
(with-output-to-string (out)
(declare (special out))
(mexpand `(mydotimes (i 3)
(mydotimes (j 3)
(princ i out)
(princ j out)))))
→ "000102101112202122" 位には圧縮できるかもしれません。
もうちょっと綺麗にできないか
とりあえずは、安直に簡単に見た目を変える方向で、リーダーマクロを使ってごちゃごちゃを隠してみましょう。
見た目がごちゃごちゃしているだけではなく、上記では、変数の結合も実行時にしているので、変数をダイナミック変数に指定していたりします。この辺りもリーダーマクロで読み取り時に展開してしまえば解決です。
なお、リーダーマクロも禁止ならファイルを2パスで処理する等々しかないですね。
(set-syntax-from-char #\] #\))
(set-macro-character
#\[
(lambda (s c)
(declare (ignore c))
(let ((form (read-delimited-list #\] s T)))
(funcall (car form) form))))(with-output-to-string (out)
[mydotimes (i 3)
[mydotimes (j 3)
(princ i out)
(princ j out)]])
→ "000102101112202122" 結論
結局の所、
- コードがデータ
- 評価器に渡るコードを変形するフックがユーザーに開放されている
の2点が言語に備わっていれば、Lispマクロのような機能と使い勝手は実現可能だということが分かるでしょうか。
特にLispには限らない筈ですが、使い勝手を含めて真面目に活用が考えられてきた、また実績があるのは、ほぼLisp系言語のみ、というのが現状だと思います。
誕生当初は、LispもM式→S式の変換をして実行するものと考えられていたLispですが、S式というデータの世界にLispプログラマが飛び込んだことが偉大だったのかもしれません。
■
HTML generated by 3bmd in LispWorks 7.1.0
世界から括弧が消えたなら
Posted 2017-12-07 17:20:25 GMT
Lisp Advent Calendar 2017 八日目です。
空きがあったのでネタで埋めようと思い書きました。
八日目書いてたのに!という方は、すいませんが、まだ空きがあるので他の日を埋めてください。
括弧が見えなくなったらどうなるの
Emacs等のエディタでは括弧だけ薄い色にしたりできるようですが、Unicodeの幅がない文字で置き換えたらどうでしょうか。
UTF-8のCommon Lispならこんな感じの設定にすればOKでしょう
(progn
(set-macro-character
(code-char #x200C)
(lambda (s c)
(declare (ignore c))
(read-delimited-list (code-char #x200D) s T)))
(set-syntax-from-char (code-char #x200D) #\)))そうしたら、こう書けます。
defun fib n
if < n 2
n
+ fib 1- n
fib - n 2fib 10
→ 55
いやあ、読み難いなあ。
エディタに支援してもらおう
Emacsには文字に構文上の意味が持たせられるので、設定しておくと便利かもしれません。
(progn
(modify-syntax-entry 8204 (format "%c%c" 40 8205))
(modify-syntax-entry 8205 (format "%c%c" 41 8204)))これで若干編集が効きますが、どうもあまり上手くいかない。
見えない括弧の応用例
Clojureっぽく書きたい人へ
Clojureは括弧が少ないんだ優勝だという人は、こういう感じはどうでしょうか。
(defun fib (n)
(cond (< n 2) n
:else (let (n1 (1- n)
n2 (- n 2))
(+ (fib n1)
(fib n2)))))まあまあですね。
オリジナルのポーランド記法にこだわる
Lispの表記法は、括弧を明示するので、Cambridge Polish Notationなどとも呼ばれます。
しかし、オリジナルのポーランド記法は、アリティが決まっているなら括弧を不要にできることこそがその特長だったようです。
その意向を汲んでみました。
(defun fib (n)
if (< n 2)
n
(+ fib 1- n
fib (- n 2)))アリティを暗記していないといけないので、読み書きで脳に負担がかかりそうですね。
結論
括弧は脳に優しい。
■
HTML generated by 3bmd in LispWorks 7.1.0
Common Lisp と タイムゾーン と Zetalisp
Posted 2017-12-04 15:00:01 GMT
Lisp Advent Calendar 2017 五日目です。
Common Lisp は移動体上でのタイムゾーンを意識して設計されている?
Common Lispのタイムゾーンについては移動体のことを考慮し、定数になっていないというような話が前々から気になっていたので、実際のところどうなのだろうと思って調べてみた。
CLtLでタイムゾーンを返すものが変数ではなく関数なのは、タイムゾーン間を移動する乗り物に使われた場合を想定しているという説明で配慮の細かさに感動したが、乗り物にCommon Lispが使われているという例を知らない。
— Miura Hideki (@miura1729) October 29, 2011
Common Lispでタイムゾーンを返す関数は、移動している車等での使用を考慮して、定数ではなく関数にしたという話を思い出した。 >RT
— Miura Hideki (@miura1729) August 18, 2013
その点、Common Lispは乗り物での運用を考えてタイムゾーンは定数ではなく関数
— Miura Hideki (@miura1729) November 30, 2017
元ネタ
多分、元ネタはCLtL2なんだろうと思うので検索してみると、CLtL2のget-decoded-timeとdecode-universal-timeの注釈にある、
Compatibility note: In Lisp Machine Lisp time-zone is not currently
returned. Consider, however, the use of Common Lisp in some mobile
vehicle. It is entirely plausible that the time zone might change from
time to time.だと思われる。
この注釈の解釈だけれど、Common Lispがタイムゾーンを意識してどうのこうのしたというよりは、互換性にかこつけて、Zetalispがタイムゾーンを返さないことについて細かいツッコミをいれているように思えるのだがどうだろうか。
CLtL1も確認してみたら、同様の記述だったので、1984年時点の認識らしい。
移動体であればCommon Lisp処理系は結局ホストのOSかどこかからタイムゾーンの情報を貰ってくることになるが、基盤となるuniversal-timeは1900-01-01T00:00Zからの秒数なので基本的にこれが動くこともなく、どこのタイムゾーンとしてデコードするか、という話になる。
ちなみに、今どのタイムゾーンにいるかを処理系がホストと通信したりして把握する手順/機構のようなものはCommon Lispの規格上には定義されていない。
文句を付けられていたZetalisp(Lisp Machine Lisp)は実際どうだったのか
それで、実際Zetalisp(Lisp Machine Lisp)がどうだったのかをソースで確認してみたが、1982年頃のSystem 78.48では確かにタイムゾーンは返していなかった。
しかし、1984年のSystem 99のソースとその時期のマニュアルであるChinual 6ではタイムゾーンを返すようになっているので、CLtL1が出版された前後で既にCLtL1のZetalispとの互換性の注釈は、時代遅れなものになっていたらしい。
1984年は、MIT LispMもCommon Lisp化した時期なので、ZetalispがCommon Lispを取り込んでしまった、もしくは、ZetalispがCommon Lisp化した、とも考えられるので微妙ではあるが……。
1983年のChinual 5を眺めるとまだタイムゾーンは返していないようなのでCLtL1執筆時のツッコミがChinual 6に影響したのかもしれない。
しかし、1990年に出版されたCLtL2でも、この趣味的な記述がアップデートされることもなく、Zetalispはタイムゾーンを返さないといわれっぱなしで今に至ることになったらしい。
ちなみに、Zetalispでもuniversal-timeへのエンコードについては1980年より前からタイムゾーンは指定する仕様になっているので、デコードされたuniversal-timeから元のuniversal-timeが復元できない非対称性についてのツッコミであったかもしれない。
まとめ
Lisp関係の伝説においては、誰も気にしないので検証もされないような趣味的なものが延々と語り継がれることって多い気がする。
折角なのでスマホ上の処理系でGPSからデータを取得してuniversal-timeをデコードするようなものがあったら面白いかもしれない。
■
HTML generated by 3bmd in LispWorks 7.1.0
Hexstream CLOS MOP Specの紹介
Posted 2017-11-30 17:40:58 GMT
今年も始まりました、Lisp Advent Calendar 2017 第一日目です。
今回は、Hexstream CLOS MOP Specを紹介します。
Hexstream CLOS MOP Specというのは私が勝手に命名したものなので正式名称でもなんでもないのですが、 HexstreamことJean-Philippe Paradis氏がまとめたCLOS MOPのオンラインリファレンスです。
正式名称は、Common Lisp Object System Metaobject Protocol と素材そのままのようですね。
CLOS MOPとはなんぞや
そもそもCLOS MOPとは、ということになるのですが、Common Lispのオブジェクトシステムは、オブジェクト指向プログラミングによって、ユーザーがカスタマイズ可能です。
インスタンスの生成、スロット(メンバ変数)アクセス、継承の仕方等々が、プロトコルとしてまとめられているのですが、操作対象は通常のオブジェクトから一段階メタになってメタオブジェクトとなります。
通常のオブジェクトが車だとしたら、車を組み立てるロボット(仕組み)が更にまたオブジェクトになっていて色々いじれるという感じです。
車を組み立てるロボットをカスタマイズすることにより、車の作り方や、作られる車の構成をカスタマイズ可能、くらいの所でしょうか。
CLOS MOPでのメタオブジェトは総称関数、メソッド、スロット定義、メソッドコンビネーション、スペシャライザ等がありますが、Hexstream CLOS MOP Spec ではすっきり図になっているので、どんな感じの構成になっているかわかりやすいと思います。
CLOS MOPの仕様について
残念ながらこのCLOS MOPですが、ANSI Common Lispの規格には組込まれることはありませんでした。
割と早い段階からCLOS三部構成のうち、三番目に位置するものとされ、仕様も詰められていましたが、1990年代初頭当時としては野心的過ぎたのか、うちの処理系ではMOPはサポートしないと明言するような主力ベンダーも現われたり、紆余曲折あって、最初の二部までがANSI Common Lispとして規格化される、という流れになりました。
規格としてはまとまらなかったものの、その前の段階の準備や成果が、The Art of the Metaobject Protocolという書籍としてまとめられます。
(正確には同時進行ですが)
通称AMOPとして有名な本ですが、この本の5章と6章はCLOS MOPの仕様がまとめられた章で、この仕様の部分はオンラインでも公開され、CLOS MOPの仕様といえば、この公開されたAMOPの仕様部分ということになっています。
このAMOPのCLOS MOP仕様部分は、TeX等の形式で配布されていましたが、1997年に当時Eclipse Common Lispを作っていた Elwood Corporation の Howard R. Stearns氏がHyperSpecに似た感じのhtml形式にして公開しました。
これが広く長らく使われていて、Franzなどもマニュアルの一部として配布しています。
しかし、Elwood版は、それほど使い勝手が良いとはいえず、改良するにもライセンスとして改変不可だったりするので、元のTeXからhtmlを仕立てる人が出てきたという所で、Robert Strandh氏や、今回紹介するHexstream氏のバージョンがそれにあたります。
Strandh氏のものはシンプルにまとめてあり、さらに注釈も添えられ、HyperSpecへのリンクもあるので、読み進めるのに便利です。
このStrandh氏のまとめたものを更に体裁よくまとめたものが、Hexstream氏のバージョン、というところです。
たとえば、Hexstream氏のものはプロトコルごとに眺められたりして、なかなか良いです。
また、関数名がidになっているので、Emacs等からドキュメントを検索するのも楽です。
簡単な関数を書けば、ブラウザで開くことも可能でしょう。
(defun amop-lookup (&optional symbol-name)
(interactive)
(let ((name (or symbol-name
(thing-at-point 'symbol))))
(setq name (subseq name (1+ (or (string-match ":" name) -1))))
(browse-url
(format "https://clos-mop.hexstreamsoft.com/generic-functions-and-methods/#%s"
name ))))(c2mop:effective-slot-definition-class ...)のようなシンボルの上で、M-x amop-lookupすれば、該当のページが開きます。
まとめ
今回は、Hexstream CLOS MOP Specを紹介しました。
とっつきにくいAMOPのリファレンスですが、綺麗にまとまっていると読み進めるのが楽で良いですね。
■
HTML generated by 3bmd in LispWorks 7.1.0
ボディが無限リスト 其の二
Posted 2017-11-15 12:02:15 GMT
大分古くからあるものだけれど、Olin Shivers氏が式のボディ部が無限リストになっているという面白いアイデアを書いていて、以前ちょっと考えてみたりした。
無限リストに関数を詰めて呼んでみたり、という感じだったけれども、より直接的には、evalが使えるなと考えた。
なお、評価はちょっと間違うと無限ループになるので注意。
(progv '(i) '(0)
(catch :exit
(eval
'(progn . #0=((when (= 1000 i) (throw :exit :done))
(print i)
(incf i)
. #0#)))))以上、暇だったので。
■
HTML generated by 3bmd in LispWorks 7.0.0
続ClaspがSBCLより速くなったと聞いて
Posted 2017-11-03 19:13:46 GMT
昨日のエントリーで「なぜかbench-stringというベンチでClaspがズバ抜けて速い」と書いたが、Twitterでこの件について反応があった。
BENCH-STRING が速いの、最適化でその部分のコードがごそっと削除されてるからとかいうオチがありそうな。
— Kei @tk_riple
なるほど、最適化によるコード削除疑惑。
Common Lispの場合、最適化した際にdotimes等で返り値を使わない場合によく消えたりはするかもしれない。
しかし、消えてる感じにしては遅いので、まあまあそんなものかなと思っていた。
また、現状のClaspはまだ最適化がどうの、というより、まずは正しく動かすフェイズな気がするので、そんなに最適化もがんばってはいないという印象を持っていた。
実際、最適化の指定をしても型のヒントを与えても全然効いてないように思う。
結論: Claspのバグが原因で実行されないコードがあったため速かった
結論から書いてしまうと、Claspのfillのバグが原因でfill以降が実行されない為に速かった。
なので、最適化ではないけれど、searchの部分のコードが削除されていた状態になっていた。
一応順を追って説明してみる。
まず、元のコードについて。
(defun bench-strings (&optional (size 1000000) (runs 50))
(declare (fixnum size))
(let ((zzz (make-string size :initial-element #\z))
(xxx (make-string size)))
(dotimes (runs runs)
(and (fill xxx #\x)
(replace xxx zzz)
(search "xxxd" xxx)
(nstring-upcase xxx))))
(values))同じ長さの大きい文字列を2つ作ってfillで‘x’で埋め、もう片方でreplaceし、“zzzz…”という文字列にしてしまう。
それをsearchで“xxxd”について検索するが見付からないので、nstring-upcaseは実行されない、という流れ。
andで繋いでいるのは、指摘があったような最適化でコードが消えるのを防いでいるのかもしれない。
とりあえず、dotimesの中身を全部消したものと比較すると、全部消したものがずっと速いので、中身を全部消しているということはなさそう。
そこで一つずつ足していってみたが、そこでClaspのvectorに対してのfillの返り値がnilであることに気が付いた。
仕様では、fillはsequenceを返すことになっているが、nilが返ってしまうとandで繋いでいるだけに以降が実行されないことになってしまう。
Claspのソースを確認してみると、
(defun fill (sequence item &key (start 0) end)
;; INV: WITH-START-END checks the sequence type and size.
(reckless
(with-start-end (start end sequence)
(if (listp sequence)
(do* ((x (nthcdr start sequence) (cdr x))
(i (- end start) (1- i)))
((zerop i))
(declare (fixnum i) (cons x))
(setf (first x) item))
(si::fill-array-with-elt sequence item start end)))))となっていて、vectorの場合は、si::fill-array-with-eltの返り値となるが、そのsi::fill-array-with-eltはClaspらしくC++で書かれていた。
/*! Fill the range of elements of the array,
if end is nil then fill to the end of the array*/
CL_LISPIFY_NAME("core:fill-array-with-elt");
CL_DEFUN void core__fillArrayWithElt(Array_sp array, T_sp element, cl_index start, T_sp end) {
size_t_pair p = sequenceStartEnd(core::_sym_fillArrayWithElt,
array->arrayTotalSize(),start,end);
array->unsafe_fillArrayWithElt(element,p.start,p.end);
}core__fillArrayWithEltはvoidなので、多分CLの世界ではnilを返すことになるのだろう。
ということで、
(defun fill (sequence item &key (start 0) end)
;; INV: WITH-START-END checks the sequence type and size.
(reckless
(with-start-end (start end sequence)
(if (listp sequence)
(do* ((x (nthcdr start sequence) (cdr x))
(i (- end start) (1- i)))
((zerop i))
(declare (fixnum i) (cons x))
(setf (first x) item))
(si::fill-array-with-elt sequence item start end))
sequence)))(fill (make-string 42) #\*)
→ "******************************************"
のように修正し、再度SBCLと比べてみた
バグを修正して再計測: 最適化指示ありなしで比べてみる
最適化指示なしだと依然としてClaspの方が3倍位速いらしい。
しかし、指示ありだと、SBCLがClaspの2倍位速くなった。
一応SBCLの方のdisassemble結果を確認したが、中身がごっそり消されているということはなかった。
Claspの方は、最適化指示ありでもなしでもあまり変わらず。
従来のCL処理系は、普段は遅めだけど、追い込むと速い、という傾向があるが、Claspは、普段から速めで、追い込んでもそんなに速くならない系になっていくのかもしれない。
なお、一応Claspにバグ報告は出してみた。
SBCL
(bench-strings)
;=> nil
#|------------------------------------------------------------|
Evaluation took:
0.595 seconds of real time
0.594982 seconds of total run time (0.594982 user, 0.000000 system)
100.00% CPU
1,958,880,795 processor cycles
8,000,064 bytes consedIntel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz
|------------------------------------------------------------|#
Clasp
(bench-strings)
;=> nil
#|------------------------------------------------------------|
Real time : 0.208 secs
Run time : 0.208 secs
Bytes consed : 8026792 bytes
LLVM time : 0.000 secs
LLVM compiles : 0
clang link time : 0.000 secs
clang links : 0
Interpreted closures: 0
nil
|------------------------------------------------------------|#SBCL 最適化指示あり
(defun bench-strings+ (&optional (size 1000000) (runs 50))
(declare (optimize (speed 3) (safety 0) (debug 0)))
(declare (fixnum size runs))
(let ((zzz (make-string size :initial-element #\z))
(xxx (make-string size)))
(declare (simple-string xxx zzz))
(dotimes (runs runs)
(and (fill xxx #\x)
(replace xxx zzz)
(search "xxxd" xxx)
(nstring-upcase xxx))))
(values))(bench-strings+)
;=> nil
#|------------------------------------------------------------|
Evaluation took:
0.104 seconds of real time
0.103990 seconds of total run time (0.103990 user, 0.000000 system)
100.00% CPU
342,637,002 processor cycles
8,000,064 bytes consed
Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz
|------------------------------------------------------------|#
Clasp 最適化指示あり
(proclaim '(optimize (speed 3) (safety 0) (debug 0)))(defun bench-strings+ (&optional (size 1000000) (runs 50))
(declare (fixnum size runs))
(let ((zzz (make-string size :initial-element #\z))
(xxx (make-string size)))
(declare (simple-string xxx zzz))
(dotimes (runs runs)
(and (fill xxx #\x)
(replace xxx zzz)
(search "xxxd" xxx)
(nstring-upcase xxx))))
(values))
(bench-strings+)
;=> nil
#|------------------------------------------------------------|
Real time : 0.222 secs
Run time : 0.222 secs
Bytes consed : 8026792 bytes
LLVM time : 0.000 secs
LLVM compiles : 0
clang link time : 0.000 secs
clang links : 0
Interpreted closures: 0
nil
|------------------------------------------------------------|#
■
HTML generated by 3bmd in LispWorks 7.0.0
ClaspがSBCLより速くなったと聞いて
Posted 2017-11-02 19:05:04 GMT
Shibuya.lisp Lispmeetup #57 の発表でClaspがSBCLより速かったりするらしいというのを耳にして、いつの間にかそこまで進歩してたのかと思ったので早速自分も試してみることにした。
ビルドは、本家のWikiの通りに実行し特に問題もなくビルドはできた。ただ時間は、3時間程度掛った。
Clasp 0.5 Build Instructions
cl-benchで計測してみる
3年位前にclaspが登場した頃に、一度clasp 0.2でcl-benchを実行してみたが、完走できない項目ばかりだった。
今回のclasp 0.5で試してみたところ大体の項目が完走できた。しかし物によってはSegmentation faultで処理系ごと落ちたりもする。
cl-bench は、Symbolics CLや、Lucid CLでも走る位なので可搬性は高い、というか規格内の機能だけで書いてある(多分)。
cl-benchや手元で確認してみる感じでは、SBCLより速かったりすることは無さそうに思えた。
さらに安定性については、まだ比較対象にならないという感じ。
目につくところでは、なぜかbench-stringというベンチでClaspがズバ抜けて速い。
bench-stringの定義はこんな感じ
(defun bench-strings (&optional (size 1000000) (runs 50))
(declare (fixnum size))
(let ((zzz (make-string size :initial-element #\z))
(xxx (make-string size)))
(dotimes (runs runs)
(and (fill xxx #\x)
(replace xxx zzz)
(search "xxxd" xxx)
(nstring-upcase xxx))))
(values))全体的な印象としては、依然としてClaspはまだまだ開発中という感じがした。
ClaspはC++との連携が最大の強みだと思うが、自分はC++の資産を使うこともないので、UTF-8をサポートするまで様子見でも良いかなというところ。
ちなみに、個人的には、SICLのコードが全面的に使われるらしいというところに興味がある。現状は、まだまだECLのコードが多い様子。
下記にベンチ結果を載せてみる。
なお、ECLやClaspと同じくSBCLはGMPを有効にしてある。
使用したマシンは、CPUが、Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz でメモリは32GiB
ベンチ
■
HTML generated by 3bmd in LispWorks 7.0.0
再帰的に自己を一回だけインライン展開する
Posted 2017-10-29 23:34:38 GMT
日立が開発していたメインフレーム用Common LispであるHiLISP(VOS3 LISP)についての記事・知識処理用言語HiLISPの高速化方式 — 日立評論 1987年3月号を読んでいて、再帰呼び出しを一回だけインライン展開するという方法が紹介されているのを目にした(記事では、自己再帰展開と呼んでいる)。
面白そうなのでこの自己再帰展開™というものを再現してみることにした。
最近のCommon Lispの処理系ではインライン指定すれば再帰的に展開してくれるものもあれば、そうでないものもあり、展開の仕方もまちまちだけれどもfletで関数内関数を定義し、それにインライン指定すれば簡単に実現できると思われる。
(defmacro defsubstself (name (&rest args) &body body)
`(defun ,name (,@args)
(flet ((,name (,@args)
,@body))
(declare (inline ,name))
,@body)))(defsubstself fib/ (n)
(declare (optimize (speed 3) (safety 0) (debug 0)))
(declare (fixnum n))
(the fixnum
(if (< n 2)
n
(+ (fib/ (1- n))
(fib/ (- n 2))))))
===>
(defun fib/ (n)
(flet ((fib/ (n)
(declare (optimize (speed 3) (safety 0) (debug 0)))
(declare (fixnum n))
(the fixnum (if (< n 2) n (+ (fib/ (1- n)) (fib/ (- n 2)))))))
(declare (inline fib/))
(declare (optimize (speed 3) (safety 0) (debug 0)))
(declare (fixnum n))
(the fixnum (if (< n 2) n (+ (fib/ (1- n)) (fib/ (- n 2)))))))fletの関数定義部のボディの中で自己を参照することはないので、一回だけ展開させるには都合が良い。
自己再帰展開™fibと通常のfibを比べるとLispWorksでは25%程高速化した。
めでたしめでたし。
解決かと思ったが……
fletを使えばできると思ったが、しかし、大域関数をfuncallした場合は、どうなるだろう。
もちろんfletで作った関数は大域関数ではないので呼ぶことはできない。
具体的には下記のような場合。
(defun fib (n)
(declare (optimize (speed 3) (debug 3) (safety 0)))
(declare (fixnum n))
(the fixnum
(if (< n 2)
n
(+ (funcall 'fib (1- n))
(funcall 'fib (- n 2))))))そもそも、こういう場合は、インライン展開はどうなるのだろうか。
インライン展開してくれそうな処理系で調べてみると、fibにinline宣言がされた場合の挙動は、
| 処理系 | funcall 'fn | funcall #'fn |
|---|---|---|
| LispWorks | 展開する | 展開する |
| SBCL | 展開しない | 展開する |
| Allegro CL | 展開しない | 展開しない |
という風に、展開したりしなかったりの様子。
funcall 'fnでもコンパイル時にはインライン指定のスコープはfuncall #'fnと同様に確定できると思われるので、SBCLが展開しないのはちょっと不思議。
3.2.2.3 Semantic Constraints にも
Within a function named F, the compiler may (but is not required to)
assume that an apparent recursive call to a function named F refers to
the same definition of F, unless that function has been declared
notinline. The consequences of redefining such a recursively defined
function F while it is executing are undefined.とあるので、コンパイル時に確定はできそうだけれど、an apparent recursive call to a function named Fにfuncall 'fn形式が含まれるのかは良く分からない。
(functionの定義からして、funcall #'functionは含まれるだろう)
もしかすると、LispWorksがやりすぎなのかもしれない。
ちなみに、Allegro CLはインラインについて一家言あるようなので展開しないらしい。
LispWorksでは、funcall 'fnでもインライン展開するので、大域の補助関数を作成して、それを呼び出せば良さそうだけれど、SBCLではそれでは駄目なので、結局はコードウォーキングしないといけないらしい。
ということで処理系に備わっているwalk-formを使って下記のようなものを書いてみた。
(import (find-symbol (string '#:walk-form)
#+allegro :excl
#+sbcl :sb-walker
#+lispworks :walker))
(defun replace-fn (fsym replace form env)
(let ((mark (gensym "mark")))
(subst replace mark
(walk-form
form
env
(lambda (sub cxt env)
(declare (ignore cxt env))
(when (and (consp sub))
(when (eq fsym (car sub))
(setf (car sub) mark))
(when (and (eq 'function (car sub))
(eq fsym (cadr sub)))
(setf (cadr sub) mark))
(when (or (eq 'funcall (car sub))
(eq 'apply (car sub)))
(when (and (eq 'quote (caadr sub))
(eq fsym (cadadr sub)))
(setf (caadr sub) 'function)
(setf (cadadr sub) mark))))
sub)))))
(defmacro defsubstself (name (&rest args) &body body &environment env)
(replace-fn name
`(lambda (,@args)
,@(copy-tree body))
`(defun ,name (,@args) ,@body)
env))
これは、自分の関数名の所をlambdaで置き換えてしまうので下記のような展開になる。
(なお、一度シンボルで置き換えてから lambdaフォームに直しているのは、walk-formが置き換えたフォームを更に展開し展開が止まらなくなるため。)
追記(2018-02-20)
walk-formがとる関数引数は多値を返すことになっていて、Tが返れば、それ以上展開しない、という指定が可能だった。
展開の指定をすれば、後でマーカーを置換するようなことはしなくても良い。
なお、大抵の処理系に付属のwalk-formはPortable CommonLoops(PCL)由来のものだが、この仕様は共通している。
(defun replace-fn (fsym replace form env)
(walk-form form
env
(lambda (sub cxt env &aux stopp)
(declare (ignore cxt env))
(when (and (consp sub))
(when (eq fsym (car sub))
(setf (car sub) replace)
(setq stopp T))
(when (and (eq 'function (car sub))
(eq fsym (cadr sub)))
(setf (cadr sub) replace)
(setq stopp T))
(when (or (eq 'funcall (car sub))
(eq 'apply (car sub)))
(when (and (eq 'quote (caadr sub))
(eq fsym (cadadr sub)))
(setf (caadr sub) 'function)
(setf (cadadr sub) replace)
(setq stopp T))))
(values sub stopp))))上記では、lambdaで展開してしまったが、fletでfibを定義し、funcall 'fibをfuncall #'fibに書き換えても良いと思う。
(defsubstself fib (n)
(declare (optimize (speed 3) (safety 0) (debug 0)))
(declare (fixnum n))
(the fixnum
(if (< n 2)
n
(+ (funcall 'fib (1- n))
(funcall 'fib (- n 2))))))
===>
(defun fib (n)
...
(the fixnum
(if (< n 2)
n
(+ (funcall #'(lambda (n)
(declare (optimize
(speed 3)
(safety 0)
(debug 0)))
(declare (fixnum n))
(the fixnum
(if (< n 2)
n
(+ (funcall 'fib
(1- n))
(funcall 'fib
(- n
2))))))
(1- n))
(funcall #'(lambda (n)
(declare (optimize
(speed 3)
(safety 0)
(debug 0)))
(declare (fixnum n))
(the fixnum
(if (< n 2)
n
(+ (funcall 'fib
(1- n))
(funcall 'fib
(- n
2))))))
(- n 2)))))))こうするとSBCLでも30%程の高速化となった。
ちなみに、Allegro CLだと普通に書いたものより遅くなるため、余計なことはしない方が良いらしい。
結び
HiLISPがfuncall 'fnをどう解釈するのかは分からないので、展開する場合としない場合を考えてみた。
Common Lispではインライン指定は処理系によって任意に解釈できることは知っていたが、調べてみると結構ばらばらなんだなと思った次第。
ちなみにSBCLでは、再帰的な局所関数ではlabels+inline指定をすると展開がかなり効く模様。
なお、大抵の処理系では、今回のような手作りの展開で速くなるが、Allegro CLの場合は、別の作法があるらしく、寧ろずっと遅くなるので注意。
■
HTML generated by 3bmd in LispWorks 7.0.0
cadadadadddrはなんと読んだらよいのか
Posted 2017-10-24 19:22:07 GMT
Common Lispでは carからcddddrまで30のcarとcdrの組み合わせが備え付けで定義されているが、Common Lispプログラマは、caadarのようなものを一体どのように発音しているのだろうか。
このブログのドメイン名は、cddddr.orgだが、くだだだ・だーと日本語の語感として口にしやすいので選んだりしたのだが、dの連続は良いとしても、aの連続や、cdrとcdarの違い等はどう表現したら良いのか良くく分からない。
RMSが講演でcaarを「か・あー」と発音していたのを観て、なるほど区切ってみたら案外区別が付くかもなと思い、Common Lispの備え付けに日本語的な発音を付けてみた。
区切りは、a→aとd→aに遷移する時に付けると区別がつきやすいように思う。
また、aが連続する場合は、一番目と二番目の間だけ区切りをはっきりさせると発音しやすい。
下記では区切りを促音にしているが、長音にしても良いだろう。
なお、カダーはキャダーという人もいるようだ(RMSもキャダーと発音していた)。
また、RG(グリーンブラット)は、CADRマシンをカダーと発音していた。同じMITでもまちまちらしい。
- car: かー
- cdr: くだー
- caar: かっあー
- cadr: かだー
- cdar: かっだー
- cddr: くだだー
- caaar: かっああー
- caadr: かっあだー
- cadar: かだっあー
- caddr: かだだー
- cdaar: くだっああー
- cdadr: くだっあだー
- cddar: くだだっあー
- cdddr: くだだだー
- caaaar: かっあああー
- caaadr: かっああだー
- caadar: かっあだっあー
- caaddr: かっあだだー
- cadaar: かだっああー
- cadadr: かだっあだー
- caddar: かだだっあー
- cadddr: かだだだー
- cdaaar: くだっあああー
- cdaadr: くだっああだー
- cdadar: くだっあだっあー
- cdaddr: くだっあだだー
- cddaar: くだだっああー
- cddadr: くだだっあだー
- cdddar: くだだだっあー
- cddddr: くだだだだー
この法則でいくと、本題名のcadadadadddrは、かだっあだっあだっあだだだーと読めることになる。 以上、おそまつ。
■
HTML generated by 3bmd in LispWorks 7.0.0
Lem使ってみた
Posted 2017-10-21 11:04:10 GMT
Common Lisp製のEmacs系エディタのlemがOpen Collectiveに参加したとのことで、自分も支援してみた。
自分はLispWorksを利用していて、折角LispWorksを購入したからには元を取ろうという貧乏くさい考えで、この二年位は殆どCommon Lispのコードは元より普段の職場での仕事でもLispWorksのエディタでテキストを編集している。
ということで、lemは使ったことがなかったのだが、折角なので使ってみた。
導入
とりあえず、GitHub: cxxxr: lemからソースを持ってきて、Quicklispがロードできる場所に配置。
自分は、Common Lisp処理系内部から使う派なので、あとは、(ql:quickload :lem)して、Common Lisp処理系をダンプするかすることにした。
ちなみに残念ながら現状LispWorks 7.0では上手く動かないらしい。後でちょっとみてみようかなと思う。
使ってみる
起動は、(lem:lem)。伝統のed関数から呼び出すようにしても良さそう。
自分的に必須コマンドである()を対で入力してくれるコマンド(make-())と、コッカからの移動コマンド(move-over-))がなかったので追加してみた。
lemの所作が良く分からないが、とりあえず動けば良いかなという感じ。
ちなみにこれらコマンドは1970年代のEmacsから存在している。
;; -*- lisp -*-
(ql:quickload :g000001.tools.tpd-blog)(in-package :lem)
(define-key *global-keymap* "C-_" 'undo)
(deftype whitechar ()
'(member #\Space #\Tab #\Return #\Newline))
(define-command make-\(\) (n) ("p")
(let ((cp (current-point)))
(insert-character cp #\( n)
(insert-character cp #\) n)
(prev-char n)))
(define-key *global-keymap* "M-(" 'make-\(\))
(define-key *global-keymap* "M-L" 'make-\(\))
(defun backward-search-rper ()
(save-excursion
(do* ((p (character-offset (current-point) -1))
(c (character-at p)
(character-at p)))
((char= #\) c) p)
(unless (typep c 'whitechar)
(return nil))
(character-offset p -1))))
(defun backward-delete-to-rper ()
(save-excursion
(do* ((p (character-offset (current-point) -1))
(c (character-at p)
(character-at p)))
((char= #\) c) p)
(unless (typep c 'whitechar)
(return nil))
(delete-character p)
(character-offset p -1))))
(define-command move-over-\) () ()
(let ((rper (backward-search-rper)))
(if rper
(progn
(backward-delete-to-rper)
(scan-lists (current-point) 1 1 T)
(lem.language-mode:newline-and-indent 1))
(progn
(scan-lists (current-point) 1 1 T)
(lem.language-mode:newline-and-indent 1)))))
(define-key *global-keymap* "M-)" 'move-over-\))
(define-key *global-keymap* "M-:" 'move-over-\))
(define-command Process-Entries-And-Preview (p) ("p")
(declare (ignore p))
(g000001.tools.tpd-blog:process-entries-and-preview
(buffer-filename (current-buffer))
#P"/mc/"))
(define-command Publog (p) ("p")
(declare (ignore p))
(g000001.tools.tpd-blog:publish-entries-and-preview
(buffer-filename (current-buffer))))
(define-command Insert-UNIVERSAL-TIME (p) ("p")
(declare (ignore p))
(let ((ut (get-universal-time)))
(multiple-value-bind (s m h d mo y)
(decode-universal-time ut)
(declare (ignore s))
(insert-string (current-point)
(format nil
"~D ;~D-~2,'0D-~2,'0DT~2,'0D~2,'0D"
ut y mo d h m)))))
;;; *EOF*
むすび
このブログはLispWorksのエディタから更新できるようにしていたが、何故か無駄に更新コマンドに可搬性を持たせて作成していたので、LispWorksのコマンドをちょっと変更するだけでlemからもこのブログを更新できるようになった。
ということで、この記事も記念にlemで書いてlem上から更新を実行してみた。
また、TwitterもLispWorksからしているが、これもちょっとしたコマンドの書き直しでlem上から簡単につぶやけるようになった。
基本的にエディタ側で作り込むのではなくCommon Lisp側で完結するツールを作成し、フロントエンドはほぼ呼び出すだけの構成にしておくとSLIME・lem・LispWorks等エディタで共通で使いまわせるので良いかもしれない。
lemは現在ターミナルで動くが、今後ブラウザ上や、Electron化も検討されているらしいので色々期待している。
■
HTML generated by 3bmd in SBCL 1.4.0
SAILDART Lispお宝発掘隊 (1)
Posted 2017-10-15 02:33:20 GMT
前回は、
- [TCH,LSP]
- [DWP,LSP]
- [LAP,LSP]
- [WD,LSP]
を眺めた。
今回も引き続き下から順番に確認していくことにしよう。
[STR,LSP]
Common Lispの国際標準化についての議論が行なわれていたメーリングリスト。
日本やヨーロッパ勢も参加し、ANSIからISOの流れに繋がっていく。
またこれもmhonarcでhtml化してみた。
[PLC,LSP]
日本の奥乃博先生が中心となって開催された、第三回LISPコンテストおよび第一回PROLOGコンテストのファイル
コンテストは各種ベンチマークの性能を比べる。
何故ここにあるのか謎だが、奥乃先生がSAILにいらしたのと関係があるのかもしれない。
ProLog Contestの略かと思われる。
参考
[LSC,LSP]
同上でこちらは、LiSp Contestのファイル
[MLI,LSP]
SAILで開発され使われていたALGOL記法のLISPであるMLISPのファイル。
処理系のファイルや、メールサーバーのソースコードっぽいものが点在。
参考
[WHT,LSP]
CLtL1のTeX原稿。TeXのマクロでBOLIO風の記述ができるようにしているらしい。
(BOLIOとはMIT Lispコミュニティで利用されていたマークアップ言語)
ファイルを眺めると、CLtL1はSpice Lispのマニュアルの原稿を上書きして作っていたことが分かる。
CLtL2はHTML化され今でも閲覧できるサイトもあり入手も可能だが、CLtL1はHTML化はされていないので案外貴重。
そのうちHTML化してみたい。
今回はここまで。
■
HTML generated by 3bmd in LispWorks 7.0.0
SAILDART Lispお宝発掘隊 (0)
Posted 2017-10-02 17:06:24 GMT
SAILとは、Stanford Artificial Intelligence Laboratoryの略でスタンフォードAIラボのこと。
DARTとはDump And Restore Techniqueの略だそうで、1972から1990位まで稼動していたバックアップシステムだそう。
そのアーカイブが10年位前から公開されているのが、SAILDART.ORG。
アーカイブの中には、マッカーシー先生や、クヌース先生のホームディレクトリがあったりもするし(非公開)、TeXが生れたシステムでもあるので、TeX関係のファイルも多数ある。
Lisp関係では、Common Lispの仕様策定のメールでの議論は、ここSAILのシステムを中心としていたようで多数のお宝が眠っている(と私のようなマニアは考えている)
以前から発掘に勤しんでいるのだが、一度端から端まで確認してみようかなと思い、ブログに記録を残しことにしてみた次第。
まず、システムのLSPディレクトリがあり、このディレクトリは ざっとこんな感じ
- [MAC,LSP]
- [TIM,LSP]
- [COM,LSP]
- [CLS,LSP]
- [206,LSP]
- [NEW,LSP]
- [FTL,LSP]
- [MRS,LSP]
- [AID,LSP]
- [VLI,LSP]
- [T,LSP]
- [VIO,LSP]
- [RUT,LSP]
- [OLD,LSP]
- [IL,LSP]
- [LSP,LSP]
- [SCH,LSP]
- [CMP,LSP]
- [BUG,LSP]
- [LIB,LSP]
- [QLA,LSP]
- [X3,LSP]
- [WHT,LSP]
- [MLI,LSP]
- [LSC,LSP]
- [PLC,LSP]
- [STR,LSP]
- [TCH,LSP]
- [DWP,LSP]
- [LAP,LSP]
- [WD,LSP]
ディレクトリの名前からだと、中身がなんだかさっぱり見当がつかないが、とりあえず下から全部確認していくことにしよう。
[WD,LSP]
READ.MEに
THIS DIRECTORY CONTAINS EXPERIMENTAL LISP SYSTEM PROGRAMS WHICH SHOULD
NOT BE DEPENDEN UPON等々とあるので、WDとは、Working Directoryの略かなんかだろうか。
特に見るべきものもないが、pretty.rutのファイルは、UCI LISPのプリティプリンタの定義かなんかだろうか。
[LAP,LSP]
ここも良く分からないが、UCI LISPっぽい。dfuncというのは、UCI LISPのdefunみたいなもだったと思う。
Scheme等と同じく(dfunc (foo arg)...)という形式なのが面白い。
1973年のファイルなので、この定義形式はSchemeに先行するだろう。
[DWP,LSP]
READ.MEに
All files here are on the LISP UDP as of 5/7/80.
-rpg-とあるがまったく意味が不明
MLISPの処理系のソースっぽいものがMIDASで書かれている断片がある。
[TCH,LSP]
Common Lispの仕様策定のグループで標準化について技術的な議論をするメーリングリストのアーカイブが置かれていた場所らしい。 メーリングリストの名前は、cl-technical TCHとはtechnicalということか。
とりあえずmhonarcでまとめてみた。
とりあえず、満足したので今日はここまで。
■
HTML generated by 3bmd in LispWorks 7.0.0
廃止になった expand-defclass について
Posted 2017-10-01 16:57:10 GMT
defclassで構造体を定義するのってできなかったっけかなあと思い、ちょっと調べてみたが、どうもstructure-classとの統合は未完に終わっているようで、MOPでも構造体の生成についての記述はない様子。
(make-instance (make-instance 'structure-class))に類することができれば、どうにかなりそうだが、思えば構造体にそのような道具はなく、実行時に定義するならコードを生成してからevalみたいなことになりそうだ。
ちなみに、evalが絡むと大抵
(let ((x 42))
(defstruct foo
(x x)
y
z))(make-foo)
→ #S(foo :x 42 :y nil :z nil)
みたいなことができなくなるので避けたい所。
(但し構造体については上記ができても殆ど意味がない)
構造体の定義については、defstructを書くしかないという結論になったが、それでは、defclassをdefstructに展開する方向で考えてみようということで、これに使えそうな、expand-defclassを思い出したので使ってみることにした。
(defmethod clos::expand-defclass ((proto structure-class)
(metaclass (eql 'structure-class))
name
supers
slots
class-options)
`(defstruct (,name (:include ,@supers))
,@(mapcar (lambda (s)
(if (consp s)
`(,(car s) ,(getf (cdr s) :initform))
`(,s nil)))
slots)))これを使うと下記のように書ける
(defstruct foo
x
y
z)(defclass bar (foo)
((a :initform 42)
b
c)
(:metaclass structure-class))
(make-bar)
→ #S(bar :x nil :y nil :z nil :a 42 :b nil :c nil)
(defclass bar (foo)
((a :initform 42)
b
c)
(:metaclass structure-class))をマクロ展開すると、
(defstruct (bar (:include foo)) (a 42) (b nil) (c nil))となる。
expand-defclassについて
expand-defclassは、MOPの初期(1987年頃)には存在していたが、定義構文の展開方法については具体的に規定しないことになり、定義構文のマクロ展開メソッドは諸々1988年には消えてしまった。
そのためAMOPには載っていない。
(expand-defclass prototype-instance name superclasses slots options environment)という総称関数だが、展開がメソッドでカスタマイズできるというのが、なかなか良さそう。
なお、LispWorks版は、environment 引数は取らないが、環境は取り込んでいるので謎なことをしている様子。
なお、初期MOPの仕様にほぼ沿っているexpand-defclassは、調べた限りでは、どうもLispWorksにしか存在しないようだ。
(TI ExplorerのTICLOSにはFlavorsで定義されているexpand-defclassがあったのと、Portable CommonLoopsに仕様が違う同名の関数があった。)
まとめ
Common LispもDylan位に色々統合されてくれていたら良かったのになと思ったりする。
ちなみに、Dylanでは動的さが制御できるので性能を出したい場合は制限をかけるようになっている。
また、Eclipse Common Lispは全面的にOOPで書かれているが、Dylanのようにsealed指定が可能なように拡張されていたようだ。
■
HTML generated by 3bmd in LispWorks 7.0.0
SETFのFって結局なんなの
Posted 2017-10-01 14:34:54 GMT
今日comp.lang.lispの過去ログを眺めていたら、SETFのFはFunctionのF説を説明している人をみつけた。
The thread suggests both FORM and FIELD, but the original meaning was
FUNCTION :-) When the construct was first suggested it was called
SETFQ for "set with function quoted, everything else evaluated", and
only later abbreviated to SETF. (Source: the Gabriel/Steele "Evolution
of Lisp" paper in HOPL-II).自分もMITのLispマシングループが元ネタとしたA LISP machine with very compact programsの論文には、FieldやFormという記載はなく、Fといえば、Function位だよなあと思っていたが、Evolution of Lispにも記載があるとのことなので確認してみたら、
Deutsch commented that the special form used here is called SETFQ because
"it quotes the function and evaluates everything else."
This name was abbreviated to SETF in Lisp-Machine Lisp.
Deutsch attributed the idea of dual functions to Alan Kayと書いてあった。
また、Deutsch氏の論文にも、
A more useful function is (SETFQ (fn arg1 ... argn) newvalue)
which quotes the function name and evaluates everything else.
This allows RPLACA, for example, to be defined as (LAMBDA (X Y) (SETFQ (CAR X) Y) ).とあり完全に見逃していたらしい。
この論文でいうFunctionは、CLでいうsetfのaccessorみたいな所。
ちなみに、他の説も挙げておこう。
FはForm説
これはsetfはシンボルだけではなくフォームを取るからなんだろうけど、特に誰かの裏付けはなく、なんとなくの皆の印象という感じだろうか。
FはField説
色々な所を眺めると、Kent Pitman氏が広めた感じだが、Pitman氏もDavid Moon氏から教えてもらったようなので大元はMoon氏らしい。
LISP 原書第3版(I) 13章 構造体 にも同様の説明がある。
ちなみに、Deutsch氏のsetfqの機構はAlan Kay氏のアイデアが源泉とあるが、Lisp界全体でこのアイデアが最初に登場したのは、更に10年程遡って1964年頃のLISP 2だったようだ。
なお、LISP 2はAlgolからヒントを得ている。
LISP 2のS式構文では、
(set (car x) 42)のように書ける。
まとめ
setfのFはFunctionのFだった。と書けば一行で終わる内容だが、色々書くとこんなに長くなる。
関連リンク
■
HTML generated by 3bmd in LispWorks 7.0.0
ISLISPにモジュールシステムがないのは何故か
Posted 2017-09-03 23:29:18 GMT
ISLISPではCommon Lispのようなパッケージがなくても大丈夫、という話を耳にした。
プログラムの規模によっては大丈夫なのかもしれないが、ISLISPにもパッケージを導入した実装もあることだし、実際どうなのか調べてみた。
ちなみに、パッケージが付いたISLISPであるTISLのサイトは消滅しているので下記にarchive.orgのリンクを貼っておく
また、TISLのパッケージシステムについては下記の論文が一番詳しいようだ。
ISLISPとモジュールシステム
とりあえず、調べて分かったことをまとめてしまうと
- ISLISPは産業利用が期待されており、モジュールシステムは必須と策定委員会も考えていた。
- 必須と考えてはいたものの、まとめ切れなかったので見送りとした。
ということらしい。
LISP言語国際標準化と日本の貢献 にはISLISPの成立までの流れが詳細に書いてあるが、Common Lispのパッケージシステムが採用されなかった理由としては、
- Common Lispのパッケージはデザインが古い
- パッケージ間の名前の共有関係の静的チェックが困難
- 名前の隠蔽をすることでの抽象化が上手く実現できない
あたりが述べられている。
Common Lispのパッケージシステムのデザインが良くないので、ISLISPに取り込まれず、ISLISPは将来の課題としたが、宙に浮いてしまった、というところだろうか。
ISLISPの話に、突然Common Lispが出てくるのに違和感があるかもしれないが、こちらもLISP言語国際標準化と日本の貢献を読めばISLISPがCommon Lispのサブセット的な面が強いことが分かると思う。
そもそもCommon Lispが成功したので、ANSIやISOで標準化しようという話になったが、ISO Common Lispが色々あって失敗し、ISLISPに至るという話でもある。
まとめ
ANSI Common Lispにしろ、ISLISPにしろ、時期尚早として見送ったものの、色々あってその時期は永遠にやってこなさそう、という話は多い気がする。
■
HTML generated by 3bmd in LispWorks 7.0.0
マクロ文字で絵文字を使おう
Posted 2017-08-22 16:34:42 GMT
Perl6は以前から演算子などにUnicodeにASCII外の文字を積極的に使っているが、今回アトミックな操作の演算子として⚛がはいったらしい。
こんな感じのコードらしいが、環境によっては絵文字になる様子。
my atomicint $i = 0;
start { $i ⚛= 1 }
while ⚛$i == 0 { }ということで、マクロ文字でこういう拡張が簡単にできるCommon Lispでも早速真似してみたい。
(flet ((|read-🤙| (srm chr)
(declare (ignore chr))
(cl:quote cl:funcall))
(|read-λ| (srm chr)
(declare (ignore chr))
(cl:quote cl:lambda)))
(set-macro-character #\🤙 #'|read-🤙|)
(set-macro-character #\λ #'|read-λ|))
(🤙(🤙(λ (f)
((λ (proc)
(🤙f (λ (arg) (🤙(🤙proc proc) arg))))
(λ (proc)
(🤙f (λ (arg) (🤙(🤙proc proc) arg))))))
(λ (f)
(λ (n)
(if (< n 2)
n
(+ (🤙f (1- n))
(🤙f (- n 2)))))))
10)
→ 55
Unicode 9.0 に Call Me Hand “🤙” (U+1F919) という丁度良いのがあったので使ってみた。
🤙 が開き括弧っぽいので、もう一捻りして、
(flet ((|read-🤙| (srm chr)
(declare (ignore chr))
(cons (quote funcall)
(read-delimited-list #\) srm T)))
(|read-λ| (srm chr)
(declare (ignore chr))
(cl:quote cl:lambda)))
(set-macro-character #\🤙 #'|read-🤙|)
(set-macro-character #\λ #'|read-λ|))
🤙🤙(λ (f)
((λ (proc)
🤙f (λ (arg) 🤙🤙proc proc) arg))))
(λ (proc)
🤙f (λ (arg) 🤙🤙proc proc) arg))))))
(λ (f)
(λ (n)
(if (< n 2)
n
(+ 🤙f (1- n))
🤙f (- n 2)))))))
10)
→ 55
こんなのもどうだろうか。これならLisp-1と文字数は一緒になる。
とはいえ、ここまで来るとエディタにも追加設定して追従させないといけないが。
(Emacsなら括弧の文字設定が可能なので多分大丈夫だろう)
■
HTML generated by 3bmd in LispWorks 7.0.0