読者です 読者をやめる 読者になる 読者になる

レガシーコード生産ガイド

私に教えられることなら

Smalltalk(Pharo)でLispを書いてみる

cons、first、rest、+だけだけど書いてみた。コードは最下部にある。

f:id:phaendal:20150417145415p:plain

Smalltalkで宣言的に書く

暫く前に名詞の王国 - あどけない話と、それについて言及した 言霊の國 - みねこあを読んで、ふーん宣言的にか……なるほどな、でも例えばLispインタープリタならLispEvaluator.new().eval(code)みたいに名詞に従わせるしかないのでは……?と思ってた。

しかしよく考えると、関数で言えば適用される前と後の値をオブジェクトとして注目するべきで、Lisp評価器だと

ast := AST from: code.
value := ast eval.

又は

value := LispValue evaluated: code

みたいに、「○○をhogeしたものは××になる」又は「××は○○をhogeしたもの」と書くのだろうか。

この考えが正しいとすると、この考えでのオブジェクト指向は関数型と対立するようなものじゃなくて、変化前後の値(それがイメージ全体の状態かもしれない)に注目して整理するか、変化のさせかたに注目して整理するかの違いであって、どちらも関数の世界に含まれるのかもしれない。

実際に書いてみた感想

Lisp/Clojure書いてる時も、JavaScript書いてるときもそうだったんだけど、宣言的に細かく分割して書けるとコードからイヤなカンジがしなくて楽しい。関数の長さだけに注目してたけど、宣言的な名前をつけることで短くせざるを得なくなったり、逆にコードの動きに注目した名前をつけると長くなりやすい、とかあるかも。

eval/applyで再帰するためにself evalArgs: cdrみたいな構成になったんだけど、ASTをEvaluatorとして使ってる事に気づいた。ConsをASTとして使ってるんだから、ASTがtreeとしてConsを持つんじゃなくて、そのままConsを継承する形の方がより自然に感じる。

しかし、そのやり方で組んでいると引数を評価する(carをevalしていく)ときにatomとして使っているSmalltalkのデータ全てがevalメッセージを理解できないといけない事に気づいた。ああ〜これがexpression problem(の反対側?)の片鱗か〜。

引数を評価する際にatomかどうか改めて判定すれば実現はできるんだけど、そうなると self type: car みたいに自分をevaluatorとして使ってしまう。

Pharoは各atomに直接evalを追加できるんだろうけど、そうなると今度はそのイメージでしか実行できないプログラムができあがる。これもよく聞く話で、これかぁ〜!ってカンジ。ただこれは(自分にとっては)どうでもいいかな。公開できなくなるという嫌な予感より、環境をいじって楽しむワクワクの方が強い。

それからせっかくSmalltalk環境(Pharo)使ってるんだし、とクラスブラウザとデバッガを活用してみたけど、めちゃくちゃいいなこれ。整理下手というかめんどくさがりだから分類を強制させるクラスブラウザが心地良かった。デバッガもブレークポイントの設定が面倒であまり使わなかったんだけど、勝手にいいところで止まって簡単に確認していけるのでめちゃくちゃ便利だった。

Common Lispでも同じことができるんだっけ?SLIMEでデバッガが開いたら「うわああああ!」ってメッセージ読んだらすぐ閉じてるけど、もうちょっと触ってみようかと思った。クラスブラウザも欲しいな……そういうの無いのかな……?

コード

Object subclass: #AST
    instanceVariableNames: 'tree'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Phaendal-Lisp'!

!AST methodsFor: 'setter' stamp: 'phaendal 4/17/2015 13:15'!
setTree: aTree
    tree := aTree.! !


!AST methodsFor: 'eval' stamp: 'phaendal 4/17/2015 14:20'!
evalArgs: args
    | car cdr |
    car := self eval: (args first).
    cdr := args rest.

    ^ (cdr = nil)
        ifTrue: [ Cons first: car ]
        ifFalse: [ Cons first: car rest: (self evalArgs: cdr) ].! !

!AST methodsFor: 'eval' stamp: 'phaendal 4/17/2015 13:36'!
eval
    ^ self eval: tree.! !

!AST methodsFor: 'eval' stamp: 'phaendal 4/17/2015 13:36'!
eval: aTree
    ^ (self type: aTree) caseOf: { 
        [ #atom ] -> [ aTree ].
        [ #function ] -> [ self evalAsFunction: aTree ].
    }.
    ! !

!AST methodsFor: 'eval' stamp: 'phaendal 4/17/2015 14:14'!
evalAsFunction: aTree
    | fn args |
    fn := aTree first.
    args := aTree rest.
    
    ^ self apply: fn args: (self evalArgs: args).! !


!AST methodsFor: 'type selector' stamp: 'phaendal 4/17/2015 13:37'!
typeAsAtom: aTree
    ^ #atom! !

!AST methodsFor: 'type selector' stamp: 'phaendal 4/17/2015 13:37'!
type: aTree
    ^ (aTree isMemberOf: Cons)
        ifTrue: [ self typeAsCons: aTree ]
        ifFalse: [ self typeAsAtom: aTree ].! !

!AST methodsFor: 'type selector' stamp: 'phaendal 4/17/2015 13:37'!
typeAsCons: aTree
    ^ #function! !


!AST methodsFor: 'getter' stamp: 'phaendal 4/17/2015 13:16'!
tree
    ^ tree! !


!AST methodsFor: 'apply' stamp: 'phaendal 4/17/2015 14:25'!
applyPlus: args
    | car cdr |
    car := args first.
    cdr := args rest.
    
    ^ (cdr = nil)
        ifTrue: [ car ]
        ifFalse: [ car + (self applyPlus: cdr) ].! !

!AST methodsFor: 'apply' stamp: 'phaendal 4/17/2015 14:00'!
applyCons: args
    ^ Cons first: (args first) rest: (args second).! !

!AST methodsFor: 'apply' stamp: 'phaendal 4/17/2015 14:26'!
apply: fn args: args
    ^ fn caseOf: { 
        [ #first ]  -> [ (args first) first ].
        [ #rest ]   -> [ (args first) rest ].
        [ #cons ]   -> [ self applyCons: args ].
    
        [ #+ ] -> [ self applyPlus: args ].
    }.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

AST class
    instanceVariableNames: ''!

!AST class methodsFor: 'creator' stamp: 'phaendal 4/17/2015 13:15'!
fromArray: arr
    ^ (AST new) setTree: (Cons fromArray: arr).! !

!AST class methodsFor: 'creator' stamp: 'phaendal 4/17/2015 13:17'!
fromCons: firstCell
    ^ (AST new) setTree: firstCell.! !


Object subclass: #Cons
    instanceVariableNames: 'car cdr'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Phaendal-Lisp'!

!Cons methodsFor: 'getter' stamp: 'phaendal 4/17/2015 12:37'!
rest
    ^ cdr! !

!Cons methodsFor: 'getter' stamp: 'phaendal 4/17/2015 14:00'!
second
    ^ (cdr isMemberOf: Cons)
        ifTrue: [ cdr first ]
        ifFalse: [ cdr ].! !

!Cons methodsFor: 'getter' stamp: 'phaendal 4/17/2015 12:36'!
first
    ^ car! !


!Cons methodsFor: 'setter' stamp: 'phaendal 4/17/2015 12:38'!
setRest: cell 
    cdr := cell.! !

!Cons methodsFor: 'setter' stamp: 'phaendal 4/17/2015 12:38'!
setFirst: cell
    car := cell.! !


!Cons methodsFor: 'show' stamp: 'phaendal 4/17/2015 12:41'!
asString
    ^ '(' , (self asSplicedString) , ')'.! !

!Cons methodsFor: 'show' stamp: 'phaendal 4/17/2015 12:49'!
asSplicedString
    | rest |
    (cdr = nil)
        ifTrue: [ rest := '' ]
        ifFalse: [
            (cdr isMemberOf: Cons)
                ifTrue: [ rest := ' ' , (cdr asSplicedString) ]
                ifFalse: [ rest := ' . ' , (cdr asString) ] 
             ].
    ^ (car asString) , rest.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Cons class
    instanceVariableNames: ''!

!Cons class methodsFor: 'creator' stamp: 'phaendal 4/17/2015 13:09'!
fromArray: arr
    | firstCell nowCell beforeCell |
    firstCell := Cons new.
    nowCell := firstCell.
    beforeCell := firstCell.
    arr do: [ :cell |
        beforeCell setRest: nowCell.
        (cell isMemberOf: Array)
            ifTrue: [ nowCell setFirst: (Cons fromArray: cell) ]
            ifFalse: [ nowCell setFirst: cell ].
        
        beforeCell := nowCell.
        nowCell := Cons new.
        ].
    ^ firstCell.! !

!Cons class methodsFor: 'creator' stamp: 'phaendal 4/17/2015 12:40'!
first: carCell rest: cdrCell
    ^ (Cons new) setFirst: carCell ; setRest: cdrCell.! !

!Cons class methodsFor: 'creator' stamp: 'phaendal 4/17/2015 12:38'!
first: cell
    ^ (Cons new) setFirst: cell.! !
広告を非表示にする