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-11-18

CommonORBITでデザインパターン - Template Method

| 08:06 | CommonORBITでデザインパターン - Template Method - わだばLisperになる を含むブックマーク はてなブックマーク - CommonORBITでデザインパターン - Template Method - わだばLisperになる

MOPの良い資料や教材がないかネットを漁っているのですが、CMUのLISPリポジトリにはお宝が埋れていることが多く、AMOPの5、6章のPostScriptファイルが埋まっていたりするのですが、今日は、それ以外にも面白いものをみつけたので遊んでみることにしました。

CLといえば、やはりCLOSなのですが、CLOSに至るまでに、Flavors、CommonLoops、CommonObjects、ObjectLisp、等々、色々な団体やメーカーが各々のシステムをつくっていました。

それぞれ、背景となる思想が違ったりして面白いのですが、自分がMOPを学ぶモチベーションとして、これらを今の処理系で動かして遊ぶというのがあります。

それはさておき、お題のCommonORBITなのですが、こちらはちょっと毛色が変ったものらしく、20年位前に作成されていたプロトタイプベースのシステムのようです。

このページでは、教材用のBOOPSとCommonORBIT(CORBIT)があるのですが、どちらも簡単に動かして遊ぶことができました。(BOOPSは、ファイルをコンパイルするのに補助関数をeval-whenでコンパイル時に評価するようにする必要あり)

とりあえず、オジェクト指向プログラミングの練習だとどうも馬鹿のひとつおぼえでTemplate-Methodばっかりやってしまうのですが、CORBITでもやってみました。

簡単に内容を説明すると、

template

templateがテンプレートで、op1とop2、templateというメソッドを持っていて、プロトタイプでは、op1とop2を組み合わせた雛型がtemplateです。

defobjectでの定義では関数を一緒に定義する必要はなく、defaspectで後で付けても良いのですが、templateでは、一緒に定義してみています。

concrate-1

templateを雛型にしたconcrate-1を作成し、op1と、op2のを作成します。

これで、(template 'concrate-1 "foo bar baz")のとすると、"**FOO BAR BAZ**"が返ってきます。

concrate-2

CORBITでは、CLOSにはないような機能が割と沢山あるのですが、:delegateを指定することによって、委譲もできます。

ということで、op1は、concrate-1に委譲していて、op2は、新しく定義、templateは、継承してくる、という感じになっています。

プロトタイプベースのものや、委譲などは自分は全然知らない世界だったのですが、面白い機能だと思いました。

ちなみにCLOSの上に構築されたものではないので競合はせず、同時に混ぜて使うことも可能です。

;; テンプレ
(defobject template
  (op1 :function (self str) "")
  (op2 :function (self str) "")
  (template 
   :function (self str) (op2 self (op1 self str))))

;; concrate-1作成
(defobject concrate-1 template)

(defaspect op1 'concrate-1
  :function (self str) (string-upcase str))

(defaspect op2 'concrate-1
  :function (self str) (format nil "**~A**" str))

;; concrate-2作成
(defobject concrate-2 template
  (op1 :delegate 'concrate-1)
  (op2 :function (self str) (format nil "//~A//" str)))

(template 'concrate-1 "foo bar baz")
;=> "**FOO BAR BAZ**"

(template 'concrate-2 "foo bar baz")
;=> "//FOO BAR BAZ//"