Posted 2021-01-11 20:32:42 GMT
こちらの記事を目にして、IDEでコードを自動生成するのって格好良いと思ったので、Common Lispだとどうなるか考えてみました。
とりあえず構造体の場合は何もしなくてもコンストラクタのinitargがスロット名に応じて決定されてしまうので、何もしなくてもOKです。
勝手に決まってしまうことについては賛否がありますが、便利な局面は多いかと思います。
(defstruct codable-struct)(defstruct (sample-struct (:include codable))
int
title
body
thumbnail-url
tags
categories
created-at
updated-at
comment
favoritedp
bookmarkedp
url)
(make-sample-struct :int 0
:title "title"
:body "body"
:thumbnail-url "https://example.com/image.jpg"
:tags '("tag")
:categories "cat"
:created-at 0
:updated-at 0
:comment "comment"
:favoritedp nil
:bookmarkedp nil
:url "https://example.com")
→ #S(sample-struct :int 0
:title "title"
:body "body"
:thumbnail-url "https://example.com/image.jpg"
:tags ("tag")
:categories "cat"
:created-at 0
:updated-at 0
:comment "comment"
:favoritedp nil
:bookmarkedp nil
:url "https://example.com")
クラスの場合は、構造体と違って全部指定してやらないといけません。
定義していない初期化のためのキーワード(:initarg)を指定しない場合はもちろんエラーです。
(defclass codable ()
())(defclass sample-class (codable)
(int
title
body
thumbnail-url
tags
categories
created-at
updated-at
comment
favoritedp
bookmarkedp
url))
(make-instance 'sample-class)
→ #<sample-class 402018AA93>
(make-instance 'sample-class
:int 0
:title "title"
:body "body"
:thumbnail-url "https://example.com/image.jpg"
:tags '("tag")
:categories "cat"
:created-at 0
:updated-at 0
:comment "comment"
:favoritedp nil
:bookmarkedp nil
:url "https://example.com")
→ #<error>
Common Lispだとコンストラクタのコードを生成するようなことはマクロで実現してしまうのですが、IDEが補完してくれるのが格好良いという話なので、IDE側でコードを生成して挿入したいところです。
ということで、initialize-instanceのコードを生成して、エディタのコマンドで挿入してみることにしました。
(let* ((keys (mapcar (lambda (s)
(let ((s (slot-definition-name s)))
`(,s nil ,(intern (format nil "~A?" (string s))))))
(class-slots (find-class 'sample-class)))))
`(defmethod initialize-instance ((obj sample-class) &key ,@keys)
(let ((obj (call-next-method)))
,@(mapcar (lambda (k)
(destructuring-bind (name init namep)
k
(declare (ignore init))
`(and ,namep (setf (slot-value obj ',name) ,name))))
keys)
obj)))した結果をエディタ(LispWorksのHemlock)からバッファに挿入します。
パッケージとシンボルの扱いのあれこれがあるので大分ごちゃごちゃになりました。
(defcommand "Generate Memberwise Initializer" (p)
"Generate Memberwise Initializer"
"Generate Memberwise Initializer"
(declare (ignore p))
(let ((def (current-top-level-definition-maybe)))
(if (and (listp def)
(eq (first def) 'defclass))
(progn
(end-of-defun-command 1)
(insert-string
(current-point)
(with-output-to-string (out)
(pprint
(let ((.class-name. (second def)))
(declare (special editor::.class-name.))
(eval
(read-from-string
"(let* ((keys (mapcar (lambda (s)
(let ((s (slot-definition-name s)))
`(,s nil ,(intern (format nil \"~A?\" (string s))))))
(class-slots (find-class editor::.class-name.)))))
`(defmethod initialize-instance ((obj sample-class) &key ,@keys)
(let ((obj (call-next-method)))
,@(mapcar (lambda (k)
(destructuring-bind (name init namep)
k
(declare (ignore init))
`(and ,namep (setf (slot-value obj ',name) ,name))))
keys)
obj)))")))
out))))
(message "~S is not a defclass" def))))これで、defclassの上で、“Generate Memberwise Initializer” します。
(defmethod initialize-instance
((obj sample-class)
&key
(int nil int?)
(title nil title?)
(body nil body?)
(thumbnail-url nil thumbnail-url?)
(tags nil tags?)
(categories nil categories?)
(created-at nil created-at?)
(updated-at nil updated-at?)
(comment nil comment?)
(favoritedp nil favoritedp?)
(bookmarkedp nil bookmarkedp?)
(url nil url?))
(let ((obj (call-next-method)))
(and int? (setf (slot-value obj 'int) int))
(and title? (setf (slot-value obj 'title) title))
(and body? (setf (slot-value obj 'body) body))
(and thumbnail-url? (setf (slot-value obj 'thumbnail-url) thumbnail-url))
(and tags? (setf (slot-value obj 'tags) tags))
(and categories? (setf (slot-value obj 'categories) categories))
(and created-at? (setf (slot-value obj 'created-at) created-at))
(and updated-at? (setf (slot-value obj 'updated-at) updated-at))
(and comment? (setf (slot-value obj 'comment) comment))
(and favoritedp? (setf (slot-value obj 'favoritedp) favoritedp))
(and bookmarkedp? (setf (slot-value obj 'bookmarkedp) bookmarkedp))
(and url? (setf (slot-value obj 'url) url))
obj))defclassで定義した挙動とは厳密には違いますが、こんな感じに初期化できるようになりました。
(make-instance 'sample-class
:int 0
:title "title"
:body "body"
:thumbnail-url "https://example.com/image.jpg"
:tags '("tag")
:categories "cat"
:created-at 0
:updated-at 0
:comment "comment"
:favoritedp nil
:bookmarkedp nil
:url "https://example.com")
→ #<sample-class 4020240C13>
#||
int 0
title "title"
body "body"
thumbnail-url "https://example.com/image.jpg"
tags ("tag")
categories "cat"
created-at 0
updated-at 0
comment "comment"
favoritedp nil
bookmarkedp nil
url "https://example.com"
||#初期化手続きの生成はどうもいまひとつな気がするので、スロット定義を自動生成する方法を試してみます。
とりあえず、
:initargを生成としてみます。
クラスのスロット定義からスロット名を抜き出し:initargを生成するのはこのようになります。
(defun add-initargs (class-name)
(dolist (s (class-direct-slots (find-class class-name)))
(setf (slot-definition-initargs s)
(list (intern (string (string (slot-definition-name s)))
:keyword))))
(reinitialize-instance (find-class class-name)))次にdefclassフォームの生成
(defun gen-defclass (class-name)
(let ((class (find-class class-name)))
`(defclass ,(class-name class)
(,@(mapcar #'class-name (class-direct-superclasses class)))
,(mapcar (lambda (s)
(append (list (slot-definition-name s))
(mapcan (lambda (i)
(list :initarg i))
(slot-definition-initargs s))))
(class-direct-slots class))
(:documentation ,(documentation class 'type))
(:metaclass ,(class-name (class-of class)))
(:default-initargs ,@(class-default-initargs class)))))エディタのコマンドにまとめる
(defcommand "Generate Memberwise Initializer" (p)
"Generate Memberwise Initializer"
"Generate Memberwise Initializer"
(declare (ignore p))
(let ((def (current-top-level-definition-maybe)))
(if (and (listp def)
(string-equal (first def) 'defclass))
(let ((*package* (get-buffer-current-package (current-buffer))))
(add-initargs (print (second def)))
(let ((dc (gen-defclass (second def))))
(end-of-defun-command 1)
(insert-form-at-point (current-point)
dc))
(values))
(message "~S is not a defclass" def))))これで、コマンド実行でスロット名がキーワードパッケージになった:initargが追加されたdefclassがバッファに挿入されます。
ちなみに、:initarg以外も処理する必要がありますが今回は面倒なので省略します……。
(defclass sample-class (codable)
((int :initarg :int)
(title :initarg :title)
(body :initarg :body)
(thumbnail-url :initarg :thumbnail-url)
(tags :initarg :tags)
(categories :initarg :categories)
(created-at :initarg :created-at)
(updated-at :initarg :updated-at)
(comment :initarg :comment)
(favoritedp :initarg :favoritedp)
(bookmarkedp :initarg :bookmarkedp)
(url :initarg :url))
(:documentation nil)
(:metaclass standard-class)
(:default-initargs))色々考えてみましたが、defclassの派生マクロを作る方が楽だなと思いました。
マクロを基準に考えると、IDE側の方は展開したコードから元のコードへ戻す知識が失われるという欠点があり、マクロは派生した構文の使い方をおぼえるのが手間という欠点があります。
プログラム生成の知識をIDEが持つのかマクロが持つのかの違いでしかないと考えれば、プロジェクトごとに派生した定義構文があっても別に良いのかなと思ったりしました。
■
HTML generated by 3bmd in LispWorks 7.0.0