Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2008-01-20

俺Arc祭り 2008冬 (6)

| 20:35 | 俺Arc祭り 2008冬 (6) - わだばLisperになる を含むブックマーク はてなブックマーク - 俺Arc祭り 2008冬 (6) - わだばLisperになる

惰性で続けております、俺Arc祭り。気力が無くなってまいりました。

15. Classes and Objects

クラスとオブジェクトです。単一継承にする予定とのこと。

あんまり詳しく説明はされてません。

基本的に名前の付け替えで逃げました。(++ (p1 'x))というのは逃げきれませんでした。

意味的には(incf (slot-value p1 'x))ということだと思うんですが…。

切ったり貼ったりの無理矢理風味に出来上がりました。

;;
;; 動作
(= pt (class nil 'x 0 'y 0)) ;ptというクラスを作る?

(type pt (x 0) (y 0)) ; 上記の簡便な方法?

(= p1 (new pt))    ;インスタンスをnewで作ってp1に代入

(p1 'y)    ; p1は自動的にメソッドの名前にもなり、スロットを読み出せる。
;=> 0

(++ (p1 'x)) ;読み出して、値をセット
;=> 1

;; おれおれ定義
(cl:defun %unquote (sym)
  (if (and (consp sym) (eq 'quote (car sym)))
      (cadr sym)
      sym))

(shadow 'class)
(cl:defmacro class (name &body body)
  `(cl:defclass ,(if name name (gensym)) ()
     ,(loop :for l :on body :by #'cddr 
	    :collect `(,(%unquote (car l)) :initform ,(cadr l)))))

;; classと、newのために拡張
(cl:defmacro = (place val)
  (cl:cond ((and (consp val) (eq 'class (car val)))
	    `(progn
	       (cl:setf ,place (class ,place ,@(cddr val)))
	       (defmethod ,place (slot)
		 (slot-value ,place slot))))
	   ((and (consp val) (eq 'new (car val)))
	    `(progn
	       (cl:setf ,place ,val)
	       (defmethod ,place (slot)
		 (slot-value ,place slot))))
	   ('T `(cl:setf ,place ,val))))

(shadow 'type)
(cl:defmacro type (name &body body)
  `(cl:defclass ,name ()
     ,(mapcar (cl:lambda (x) `(,(car x) :initform ,(cadr x)))
	      body)))

(cl:defmacro new (class)
  `(make-instance ',class))

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20080120