3 Smalltalk implementation of a `same-fringe' solver.
5 Use GNU Smalltalk syntax -- it seems more Emacs-friendly.
8 Object subclass: BasicNode [
9 <comment: 'I am provide common behaviour for my subclasses Node and
10 LeafNode. Otherwise, I''m not particularly interesting.'>
13 "Return a new iterator to walk this node."
15 <category: 'iteration'>
16 ^NodeIterator for: self
20 BasicNode subclass: Node [
23 <comment: 'I represent simple binary tree nodes. My instances consist of
24 a data object, and left and right subtrees. The leaves of a tree are
25 instances of LeafNode.'>
26 <category: 'Toys-SameFringe'>
28 Node class >> left: aNode data: anObject right: anotherNode [
29 "Answer a newly tree Node with the given subtrees and data."
31 <category: 'instance creation'>
32 ^self new left: aNode data: anObject right: anotherNode
35 Node class >> parse: aString [
36 "Answer a newly constructed tree, parsed from aString."
40 stream := ReadStream on: aString.
41 tree := stream parseTree.
42 stream atEnd ifFalse: [self error: 'trailing junk'].
46 left: aNode data: anObject right: anotherNode [
47 "Initialize a (presumably) new instance."
49 <category: 'initialization'>
57 "Answer the receiver's left subtree."
59 <category: 'accessing'>
64 "Answer the receiver's right subtree."
66 <category: 'accessing'>
71 "Answer the receiver's data."
73 <category: 'accessing'>
78 "Answer false, becase the receiver is not a leaf."
84 inorderTell: aBlock tell: aNodeIterator [
85 "This is the hairy part of the iteration protocol.
87 The algorithm works like this. We're meant to wander as far down
88 the left of the tree as we can; once we're there, we call
89 aNodeIterator with the data we found and a block which will continue
90 the iteration over the rest of the tree and finally invoke aBlock.
92 Observe that there are no explicit conditionals here. It's all done
93 with object dispatch. And smoke. And mirrors.
95 Also note that this is tail-recursive. The `stack' is built up in
96 the hairy block constructions, which all go on the heap."
98 <category: 'private iteration'>
103 then: [right inorderTell: aBlock tell: aNodeIterator]]
107 sameFringeAs: aNode [
108 "Answer whether traversing the receiver inorder yields the same
109 objects as traversing aNode."
111 <category: 'comparison'>
114 ib := aNode iterator.
115 [ia atEnd] whileFalse:
116 [ib atEnd ifTrue: [^false].
117 (ia next = ib next) ifFalse: [^false]].
122 "Write a simple representation of self to the stream."
124 <category: 'printing'>
132 Node class >> main: anArray [
133 "Noddy script main program."
135 <category: 'command line'>
138 [(self parse: (anArray at: 1)) iterator do:
139 [:char | FileStream stdout nextPut: char].
140 FileStream stdout nl];
142 [FileStream stdout display:
143 (((self parse: (anArray at: 1))
144 sameFringeAs: (self parse: (anArray at: 2)))
146 ifFalse: ['no match']);
148 at: anArray size ifAbsent: [self error: 'bad args'])
153 nextPutAll: 'smalltalk-fringe: ';
154 nextPutAll: error messageText;
161 PositionableStream extend [
163 "Answer a newly constructed tree, parsed from the receiver.
165 The syntax is very simple:
167 tree ::= empty | `(' tree char tree `)'
169 where char is any character. Ambiguity is resolved by deciding that
170 something beginning with `(' where a tree is expected really is a
171 tree and not an empty tree followed by the char `('."
173 <category: 'parsing'>
176 self peek = $( ifFalse: [^LeafNode instance].
178 left := self parseTree.
179 self atEnd ifTrue: [self error: 'no data'].
181 right := self parseTree.
182 self next = $) ifFalse: [self error: 'missing )'].
183 ^Node left: left data: data right: right
187 BasicNode subclass: LeafNode [
188 <comment: 'I represent the leaves of a tree of Nodes. I don''t hold any
189 kind of interesting state. My methods provide the base cases for some of the
190 recursive protocols used to handle Nodes.'>
191 <category: 'Toys-SameFringe'>
193 instance := LeafNode new.
196 "Write a simple representation of self to the stream."
198 <category: 'printing'>
203 "Answer true, because the receiver is a leaf node."
205 <category: 'testing'>
209 inorderTell: aBlock tell: aNodeIterator [
210 "This is the hairy part of the iteration protocol.
212 But in this case it's simple. We've overshot the end, so we just
213 need to call aBlock to persuade our parent to announce itself to the
216 <category: 'private iteration'>
220 LeafNode class >> instance [
221 "Return the unique instance of the leaf node."
223 <category: 'singleton'>
228 Stream subclass: NodeIterator [
231 <comment: 'I hold the state for external iteration of trees of Nodes and
232 (halfheartedly) implement the Stream protocol.'>
233 <category: 'Toys-SameFringe'>
235 found: anObject then: aBlock [
236 "Stash the newly found item from the hairy iteration protocol.
238 When the iteration protocol decides on the next leftmost item to
239 return, it gives us anObject that it found, and aBlock which will
240 continue until it finds the next object."
242 <category: 'private iteration'>
247 NodeIterator class >> for: aNode [
248 "Answer a new iterator for the tree starting at aNode."
250 <category: 'instance creation'>
251 ^self new walk: aNode
255 "Start walking a subtree starting at aNode.
257 We get the node to iterate itself and finally tell us that it's
260 <category: 'initialization'>
261 aNode inorderTell: [rest := nil] tell: self
265 "Answer the next element from the tree, or nil if we've hit the end."
267 <category: 'reading'>
276 "Answer the next element without removing it."
278 <category: 'reading'>
279 rest ifNil: [^nil] ifNotNil: [^item]
283 "Answer whether we have reached the end of the iteration."
285 <category: 'testing'>