「Ansi Common Lisp」11章読了 - ITコンサルの日常

CLOS(Common Lisp オブジェクトシステム)に関する章。
ほんとなんでもアリって感じですね。

オブジェクト指向プログラミング

オブジェクト指向に関する一般的な話なのでスルー。

クラスとインスタンス

クラスの定義とインスタンスの作成

* (defclass circle ()
    (radius center))

#<STANDARD-CLASS CIRCLE {58020A2D}>
* (setf c (make-instance 'circle))
Warning:  Declaring C special.

#<CIRCLE {5802FDAD}>
* (setf (slot-value c 'radius) 1)

1
* (slot-value c 'radius)

1
*

defclassでクラスを定義(第一引数はスーパークラスのリスト、第二引数はメンバのリストらしい)。
make-instanceでインスタンスを作成する。
slot-valueでメンバの参照を行う。

スロットの属性

:accessorを定義すると、メンバへのアクセス関数が定義される。

* (defclass circle ()
    ((radius :accessor circle-radius)
     (center :accessor circle-center)))

#<STANDARD-CLASS CIRCLE {58020A2D}>
* (setf c (make-instance 'circle))

#<CIRCLE {5805B4DD}>
* (setf (circle-radius c) 1)

1
* (circle-radius c)

1
*

:readerや:writerだと、読み込み専用、書き込み専用になるらしいので、やってみる。

* (defclass circle ()
    ((radius :reader circle-radius
             :initform 1)
     (center :writer circle-center
             )))

#<STANDARD-CLASS CIRCLE {58020A2D}>
* (setf c (make-instance 'circle))

#<CIRCLE {58082A8D}>
* (circle-radius c)

1
* (setf (circle-radius c) 2)


No matching method for the generic function
#<STANDARD-GENERIC-FUNCTION (SETF CIRCLE-RADIUS) (0) {58057611}>, when called
with arguments (2 #<CIRCLE {58082A8D}>).
   [Condition of type PCL::NO-APPLICABLE-METHOD-ERROR]

Restarts:
  0: [CONTINUE] Retry call to :FUNCTION.
  1: [ABORT   ] Return to Top-Level.

Debug  (type H for help)

("DEFMETHOD NO-APPLICABLE-METHOD (T)" #<unused-arg> #<unused-arg>
 #<STANDARD-GENERIC-FUNCTION (SETF CIRCLE-RADIUS) (0) {58057611}>
 (2 #<CIRCLE {58082A8D}>))
Source: Error finding source: 
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM:  Source file no longer exists:
  target:pcl/braid.lisp.
0] Q                              

* (setf (slot-value c 'radius) 2)

2
* (circle-radius c)

2

確かに読み取り専用になっているらしい。
ただ、slot-valueを使えば書き換えもできてしまいますけどね。
次にwriter。

* (circle-center c)



Error in function PCL::CACHE-MISS-VALUES:
   The function #<STANDARD-GENERIC-FUNCTION CIRCLE-CENTER (1) {58058B31}>
   requires at least 2 arguments.
   [Condition of type SIMPLE-ERROR]

Restarts:
  0: [ABORT] Return to Top-Level.

Debug  (type H for help)

(PCL::CACHE-MISS-VALUES
 #<STANDARD-GENERIC-FUNCTION CIRCLE-CENTER (1) {58058B31}>
 (#<CIRCLE {58082A8D}>)
 PCL::ACCESSOR)
Source: Error finding source: 
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM:  Source file no longer exists:
  target:pcl/dfun.lisp.
0] Q      

* (setf (circle-center c) '(1 1))


No matching method for the generic function
#<STANDARD-GENERIC-FUNCTION (SETF CIRCLE-CENTER) (0) {58059FB1}>, when called
with arguments ((1 1) #<CIRCLE {58082A8D}>).
   [Condition of type PCL::NO-APPLICABLE-METHOD-ERROR]

Restarts:
  0: [CONTINUE] Retry call to :FUNCTION.
  1: [ABORT   ] Return to Top-Level.

Debug  (type H for help)

("DEFMETHOD NO-APPLICABLE-METHOD (T)" #<unused-arg> #<unused-arg>
 #<STANDARD-GENERIC-FUNCTION (SETF CIRCLE-CENTER) (0) {58059FB1}>
 ((1 1) #<CIRCLE {58082A8D}>))
Source: Error finding source: 
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM:  Source file no longer exists:
  target:pcl/braid.lisp.
0] Q

* (setf (circle-center c) 2) 


No matching method for the generic function
#<STANDARD-GENERIC-FUNCTION (SETF CIRCLE-CENTER) (0) {58059FB1}>, when called
with arguments (2 #<CIRCLE {58082A8D}>).
   [Condition of type PCL::NO-APPLICABLE-METHOD-ERROR]

Restarts:
  0: [CONTINUE] Retry call to :FUNCTION.
  1: [ABORT   ] Return to Top-Level.

Debug  (type H for help)

("DEFMETHOD NO-APPLICABLE-METHOD (T)" #<unused-arg> #<unused-arg>
 #<STANDARD-GENERIC-FUNCTION (SETF CIRCLE-CENTER) (0) {58059FB1}>
 (2 #<CIRCLE {58082A8D}>))
Source: Error finding source: 
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM:  Source file no longer exists:
  target:pcl/braid.lisp.
0]

No matching method for the generic functionとか出て動かないんですが。。
なんでだろ。

まあいいや、次。
:initargでコンストラクタのキーワード引数を定義できる。:initformで初期値を定義できる。

* (defclass circle ()
    ((radius :initarg :radius
             :initform 1)
     (center :initarg :center
             :initform (cons 0 0))))
; 
#<STANDARD-CLASS CIRCLE {58020A2D}>
* (make-instance 'circle)

#<CIRCLE {580ED1B5}>
* (setf c (make-instance 'circle))

#<CIRCLE {580ED88D}>
* (format t "~A~A~%" (slot-value c 'radius) (slot-value c 'center))
1(0 . 0)
NIL
* (setf c (make-instance 'circle :radius 2))

#<CIRCLE {580F47BD}>
* (format t "~A~A~%" (slot-value c 'radius) (slot-value c 'center))
2(0 . 0)
NIL
* (setf c (make-instance 'circle :radius 3 :center '(4 . 5)))

#<CIRCLE {580F5E05}>
* (format t "~A~A~%" (slot-value c 'radius) (slot-value c 'center))
3(4 . 5)
NIL
*

Javaだったら、いちいちコンストラクタのバリエーションを用意しないといけないところですが、Rubyと一緒で非常に便利ですね。

:allocation :classを指定すると、クラス変数になるらしい。

* (defclass blog ()
    ((title :allocation :class)))

#<STANDARD-CLASS BLOG {580FF0F5}>
* (setf b1 (make-instance 'blog))

Warning:  Declaring B1 special.

#<BLOG {5810EEAD}>
* (setf b2 (make-instance 'blog))
Warning:  Declaring B2 special.

#<BLOG {58111135}>
* (setf (slot-value b1 'title) 'BlogTitle)

BLOGTITLE
* (slot-value b1 'title)

BLOGTITLE
* (slot-value b2 'title)

BLOGTITLE
*

インスタンス間で値が共有されているのが分かりますね。

スーパークラス

属性(どうもスロットっていう言い方にはなじめない。。)を継承できる。

* (defclass super ()
    (a))

#<STANDARD-CLASS SUPER {58120755}>
* (defclass sub (super)
    (b))

#<STANDARD-CLASS SUB {581313BD}>
* (setf s (make-instance 'sub))
Warning:  Declaring S special.

#<SUB {5813CB8D}>
* (setf (slot-value s 'a) 'inherited)

INHERITED
*

優先度

ダイヤモンド継承とかやったときの、どのクラスが優先になるかとかいう話。

* (defclass parent ()
    (a))

#<STANDARD-CLASS PARENT {58145455}>
* (defclass child1 (parent)
    ((b :initform 1)))

#<STANDARD-CLASS CHILD1 {58151D5D}>
* (defclass child2 (parent)
    ((b :initform 2)))

#<STANDARD-CLASS CHILD2 {5816093D}>
* (defclass grandchild (child1 child2)
    (c))

#<STANDARD-CLASS GRANDCHILD {5816F20D}>
* (setf gc (make-instance 'grandchild))
Warning:  Declaring GC special.

#<GRANDCHILD {581AF48D}>
* (slot-value gc 'b) 

1
*

grandchildの定義で、child1、child2の順に継承しているので、child1が優先されるというわけらしい。
ちなみに逆にしてみると、優先順位も逆になる。

* (defclass grandchild (child2 child1)
    (c))

#<STANDARD-CLASS GRANDCHILD {5816F20D}>
* (setf gc (make-instance 'grandchild))

#<GRANDCHILD {581CEDB5}>
* (slot-value gc 'b)

2
*

総称関数

メソッドオーバーロードに近いような印象。

* (defclass rectangle ()
    (width height))

#<STANDARD-CLASS RECTANGLE {58020A35}>
* (defclass circle ()
    (radius))      

#<STANDARD-CLASS CIRCLE {58036DC5}>
* (defmethod area ((r rectangle))
    (* (slot-value r 'width) (slot-value r 'height)))
; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL. R): 
; Compiling Top-Level Form: 

#<STANDARD-METHOD AREA (RECTANGLE) {580DE0F5}>
* (defmethod area ((c circle))
    (* (slot-value c 'radius) (slot-value c 'radius) 3.14))
; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL. C): 
; Compiling Top-Level Form: 

#<STANDARD-METHOD AREA (CIRCLE) {5815FFCD}>
* (setf r (make-instance 'rectangle))
Warning:  Declaring R special.

#<RECTANGLE {58161485}>
* (setf (slot-value r 'width) 4)

4
* (setf (slot-value r 'height) 5)

5
* (area r)

20
* (setf c (make-instance 'circle))
Warning:  Declaring C special.

#<CIRCLE {58163BCD}>
* (setf (slot-value c 'radius) 3)

3
* (area c)

28.26
*

上をJavaで書き直せば、

public class test
{
	static class Rectangle
	{
		public int width;
		public int height;
	}

	static class Circle
	{
		public int radius;
	}

	public static double area(Rectangle r)
	{
		return r.width * r.height;
	}

	public static double area(Circle c)
	{
		return c.radius * c.radius * Math.PI;
	}

	public static void main(String[] args)
	{
		Rectangle r = new Rectangle();
		r.width = 4;
		r.height = 5;
		System.out.println(area(r));

		Circle c = new Circle();
		c.radius = 3;
		System.out.println(area(c));
	}
}

こんな感じだと思うけど、Javaっぽく書くならば、

public class test2
{
	interface Shape
	{
		public double area();
	}

	static class Rectangle implements Shape
	{
		public int width;
		public int height;

		public double area()
		{
			return width * height;
		}
	}

	static class Circle
	{
		public int radius;

		public double area()
		{
			return radius * radius * Math.PI;
		}
	}

	public static void main(String[] args)
	{
		Rectangle r = new Rectangle();
		r.width = 4;
		r.height = 5;
		System.out.println(r.area());

		Circle c = new Circle();
		c.radius = 3;
		System.out.println(c.area());
	}
}

でしょうね。

補助メソッド

:before、:after、:aroundキーワードについて。なんだかAOPっぽい。

* (defmethod hoge :before ()
    (format t "before"))
; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL.): 
; Compiling Top-Level Form: 

#<STANDARD-METHOD HOGE :BEFORE () {58083B7D}>
* (defmethod hoge :after ()
    (format t "after"))
; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL.): 
; Compiling Top-Level Form: 

#<STANDARD-METHOD HOGE :AFTER () {580E010D}>
* (defmethod hoge ()
    (format t "Hello, World!"))
; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL.): 
; Compiling Top-Level Form: 

#<STANDARD-METHOD HOGE () {5813C0C5}>
* (hoge)
beforeHello, World!after
NIL
*

hoge :before → hoge本体 → hoge :afterの順に実行されているのが分かります。
次、:around

* (defmethod hoge :around ()
    (format t "before")
    (if (next-method-p) (call-next-method))
    (format t "after"))
; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL.): 
; Compiling Top-Level Form: 

#<STANDARD-METHOD HOGE :AROUND () {58259D7D}>
* (hoge)
beforebeforeHello, World!afterafter
NIL
*

:aroundがある場合は、hoge :aroundの(call-next-method)で、hoge :before → hoge本体 → hoge :afterが呼ばれてますね。

* (defmethod moge :around ()
    (call-next-method))
; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL.): 
; Compiling Top-Level Form: 

#<STANDARD-METHOD MOGE :AROUND () {582DF14D}>
* (moge)


Generic function #<STANDARD-GENERIC-FUNCTION MOGE (1) {582DE761}>: No primary
method given arguments NIL
   [Condition of type PCL:NO-PRIMARY-METHOD-ERROR]

Restarts:
  0: [CONTINUE] Try again.
  1: [ABORT   ] Return to Top-Level.

Debug  (type H for help)

("DEFMETHOD NO-PRIMARY-METHOD (STANDARD-GENERIC-FUNCTION)" #<unused-arg>
 #<unused-arg> #<STANDARD-GENERIC-FUNCTION MOGE (1) {582DE761}> NIL)
Source: Error finding source: 
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM:  Source file no longer exists:
  target:pcl/braid.lisp.
0] Q

* (defmethod moge ()
    (format t "moge called."))
; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL.): 
; Compiling Top-Level Form: 

#<STANDARD-METHOD MOGE () {58351F65}>
* (moge)
moge called.
NIL
*

オリジナル(:before、:after、:aroundが付いていない)メソッドがないのに、(call-next-method)をやると、エラーになってしまいますね。
ちなみに、:beforeとか:afterだけあってもダメなようです。

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

なんかあんまり使わなそうだからスルーでいいかな。

* (defgeneric price (x)
    (:method-combination +))

#<STANDARD-GENERIC-FUNCTION PRICE (0) {585809D1}>
* (defclass jacket() ())

#<STANDARD-CLASS JACKET {58585F3D}>
* (defclass trousers () ())

#<STANDARD-CLASS TROUSERS {5858D3DD}>
* (defclass suit (jacket trousers) ())

#<STANDARD-CLASS SUIT {58594F9D}>
* (defmethod price + ((jk jacket)) 350)
; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL. JK): 
; Compiling Top-Level Form: 

#<STANDARD-METHOD PRICE + (JACKET) {585FD7BD}>
* (defmethod price + ((tr trousers)) 200)
; Compiling LAMBDA (PCL::.PV-CELL. PCL::.NEXT-METHOD-CALL. TR): 
; Compiling Top-Level Form: 

#<STANDARD-METHOD PRICE + (TROUSERS) {58661CAD}>
* (price (make-instance 'suit))

550
*

カプセル化

パッケージ化するか、シンボルをuninternしろということらしい。

* (defclass class1 () ((a :initform 1)))

#<STANDARD-CLASS CLASS1 {586A7C0D}>
* (setf c (make-instance 'class1))
Warning:  Declaring C special.

#<CLASS1 {586BC845}>
* (slot-value c 'a)

1
* (unintern 'a)

T
* (slot-value c 'a)



Error in function "DEFMETHOD SLOT-MISSING (T T T T)":
   When attempting to read the slot's value (slot-value), the slot A is missing
   from the object #<CLASS1

   {586BC845}>.
   [Condition of type SIMPLE-ERROR]

Restarts:
  0: [ABORT] Return to Top-Level.

Debug  (type H for help)

("DEFMETHOD SLOT-MISSING (T T T T)" #<unused-arg> #<unused-arg> #<unused-arg>
 #<CLASS1 {586BC845}> ...)
Source: Error finding source: 
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM:  Source file no longer exists:
  target:pcl/slots.lisp.
0]

そりゃそうだろって気がしないでもないですが。

(10.2追記)
円の面積=πr^2なのに、π^2rになってた。。はずかし。