#:g1: slot-valueを排除する試み(2)

Posted 2019-11-10 19:19:05 GMT

前回はとりあえず、インスタンスのアクセスにslot-valueを使わないようなメタクラスを定義してみたりしましたが、slot-value排除を推進してインスタンスの初期化にも細工してみたいと思います。
slot-value経由でのアクセスの廃止=カプセル化という応用で考えてみます。

encapsulated-class

本当はインスタンスの初期化からもslot-valueを排除したかったのですが、気付いたらslot-valueを自作していた感があったので、slot-valueは初期化メソッドの内部でしか利用させないという制限を付けることにしました。
制限の手段としては安直にクラスに class-encapsulated-pを定義して管理します。
slot-value...系はclass-slotsの情報を元に動作することになるので、大元のclass-slotsに制限を掛けてやることにします。
今回は、class-encapsulated-pTの時はclass-slotsがエラーを発するようにしてみました。

encapsulated-object

オブジェクトの初期化をカスタマイズするには、standard-objectを派生させる必要があるので、encapsulated-objectを定義し、これの初期化をカスタマイズします。

カプセル化と継承についての問題で、アクセス制限をどう継承するか、というものがあるようですが、今回は継承側の勝手に任せることにしました。

ということでこんな動きになりました。

;; utils
(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf (fdefinition 'a) #'make-instance))

(defconstant <zot> (defclass zot (encapsulated-object) ((a :initform 0 :accessor zot.a)) (:encapsulated-p T) (:metaclass encapsulated-class)))

(class-encapsulated-p <zot>) → T

(slot-value (a <zot>) 'a) !!! Illegal reflective access: #<encapsulated-class zot 4120259C13>.

(zot.a (a <zot>)) → 0

(defconstant <quux> (defclass quux (zot) ((x :initform 42) (y :initform 42) (z :initform 42)) (:encapsulated-p nil) (:metaclass encapsulated-class)))

(class-encapsulated-p <quux>) → nil

(with-slots (a x y z) (a <quux>) (list a x y z))(0 42 42 42)

定義

(cl:in-package cl-user)

(load "via-accessor-class")

(eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickload :closer-mop) (when (find-package "a6acd6f5-46a2-51bf-83be-8596ac2d2f35") (delete-package "a6acd6f5-46a2-51bf-83be-8596ac2d2f35")))

(defpackage "a6acd6f5-46a2-51bf-83be-8596ac2d2f35" (:use :c2cl))

(in-package "a6acd6f5-46a2-51bf-83be-8596ac2d2f35")

(defmacro in-syntax (name) `(progn (defvar ,(intern name) (copy-readtable nil)) (setq *readtable* ,(intern name))))

(defmacro local-prefix-setup () `(set-macro-character #\~ (lambda (srm chr) (declare (ignore chr)) (intern (concatenate 'string (string 'encapsulated-) (string (read srm)))))))

(in-syntax "a6acd6f5-46a2-51bf-83be-8596ac2d2f35") (local-prefix-setup)

(define-condition illegal-reflective-access (simple-error) () (:report (lambda (condition stream) (format stream "Illegal reflective access: ~{~S~}." (simple-condition-format-arguments condition)))))

(defclass ~class (|3d0ecf39-dd6c-53f5-9672-58d5f5408cc6|:via-accessor-class) ((~p :initform T :initarg :encapsulated-p :accessor class-encapsulated-p)))

(defmethod ensure-class-using-class :around ((class ~class) name &rest initargs &key (~p T ~p-sup?)) (if (and ~p-sup? (consp ~p)) (apply #'call-next-method class name :encapsulated-p (car ~p) initargs) (call-next-method)))

(defmethod validate-superclass ((class ~class) (super standard-class)) T)

(defmethod class-slots :around ((class ~class)) (if (class-encapsulated-p class) (error 'illegal-reflective-access :format-arguments (list class)) (call-next-method)))

(defclass ~object (standard-object) ())

(defmethod shared-initialize ((instance ~object) slot-names &rest initargs) (flet ((initialize-slot-from-initarg (class instance slotd) (let ((slot-initargs (slot-definition-initargs slotd))) (loop :for (initarg value) :on initargs :by #'cddr :do (when (member initarg slot-initargs) (setf (slot-value-using-class class instance slotd) value) (return t))))) (initialize-slot-from-initfunction (class instance slotd) (let ((initfun (slot-definition-initfunction slotd))) (unless (or (not initfun) (slot-boundp-using-class class instance slotd)) (setf (slot-value-using-class class instance slotd) (funcall initfun)))))) (let* ((class (class-of instance)) (encapsulated-p (class-encapsulated-p class))) (unwind-protect (progn (setf (class-encapsulated-p class) nil) (loop :for slotd :in (class-slots class) :unless (initialize-slot-from-initarg class instance slotd) :do (when (or (eq t slot-names) (member (slot-definition-name slotd) slot-names)) (initialize-slot-from-initfunction class instance slotd)))) (setf (class-encapsulated-p class) encapsulated-p))) instance))

(defmethod finalize-inheritance :around ((class ~class)) (let ((encapsulated-p (class-encapsulated-p class))) (unwind-protect (progn (setf (class-encapsulated-p class) nil) (call-next-method)) (setf (class-encapsulated-p class) encapsulated-p))))

まとめ

slot-value排除の応用としてカプセル化も考えつつも、初期化でのslot-valueの扱いは日和るという中途半端な考察で、slot-valueを排除するのはなかなか面倒ということが分かっただけでした。

今回は、アクセス制限については、class-slotsでの制御としましたが、スロットをカスタマイズする方法もありそうです。

ちなみに、カプセル化の方法として、自由(uninterened)シンボルを使うというのがあるらしいですが、秘匿効果としては微妙な気がしています。
Pythonの命名規約の__foo__みたいなものでしょうか。

;;; importすれば簡単にシンボルは捕捉できる
(defclass foo ()
  (#:a #:b #:c))

(class-slots (find-class 'foo))(#<standard-effective-slot-definition #:a 40201BF60B> #<standard-effective-slot-definition #:b 40201BF673> #<standard-effective-slot-definition #:c 40201BF6DB>)

(mapc (lambda (s) (shadowing-import (slot-definition-name s))) (class-slots (find-class 'foo)))(#<standard-effective-slot-definition a 417024825B> #<standard-effective-slot-definition b 4170248753> #<standard-effective-slot-definition c 4170248C63>)

(setf (slot-value (make-instance 'foo) 'a) 42) → 42


HTML generated by 3bmd in LispWorks 7.1.2

comments powered by Disqus