Revert "Revert "Made use of ::= in core libraries and defined a RebindError condition...
[cslatevm.git] / src / lib / tree.slate
blob5d2c840d632acc2742fa8a19921b3eca3d61b4a9
1 collections define: #OrderedTree
2   &parents: {LinkedCollection. ExtensibleSequence}
3   &slots: {#treeParent. "The parent node, Nil for top-level nodes."
4            #children -> ExtensibleArray new "The sub-nodes."}.
5 "A Tree node, linking to its parent node and storing its children in a
6 Sequence."
8 ot@(OrderedTree traits) clear
10   ot children := ot children new.
11   ot
14 ot@(OrderedTree traits) new &capacity: n
15 [ot clone `setting: #{#children} to: {ot children new &capacity: n}].
17 ot@(OrderedTree traits) newFor: obj &capacity: n
18 [(ot new &capacity: n) `>> [add: obj]].
20 ot@(OrderedTree traits) newForAll: c@(Collection traits)
21 [ot clone `setting: #{#children} to: {c as: ot children}].
23 ot@(OrderedTree traits) size [ot children size].
25 ot@(OrderedTree traits) do: block [ot children do: block].
27 ot@(OrderedTree traits) at: index [ot children at: index].
29 ot@(OrderedTree traits) iterator
30 [ot children iterator].
32 ot@(OrderedTree traits) reader
33 [ot children reader].
35 ot@(OrderedTree traits) writer
36 "NOTE: If the children object is not Extensible. Otherwise, a new structure
37 may be constructed which is not placed into the slot implicitly."
38 [ot children writer].
40 ot@(OrderedTree traits) siblings
41 "Return all children of the node's parent, excepting the original node.
42 Answer Nil if there is no parent or the wrong parent."
44   ot treeParent
45     ifNil: [ExtensibleArray new]
46     ifNotNilDo: [| :p | p children copy `>> [remove: ot ifAbsent: [^ Nil]. ]]
49 ot@(OrderedTree traits) previousSibling
50 [ot treeParent ifNotNilDo: [| :p | p children before: ot]].
52 ot@(OrderedTree traits) nextSibling
53 [ot treeParent ifNotNilDo: [| :p | p children after: ot]].
55 ot@(OrderedTree traits) raise
56 "Moves this tree element to the first in the collection list of the parent -
57 relies on being able to directly manipulate that collection."
59   ot treeParent children move: ot to: ot children indexFirst.
62 ot@(OrderedTree traits) bury
63 "Moves this tree element to the last in the children list of the parent -
64 relies on being able to directly manipulate that collection."
65 [| siblings |
66   (siblings := ot treeParent children) move: ot to: siblings indexLast.
69 ch@(OrderedTree traits) reparentTo: ot
70 "Handle the aspect of unsetting any parent link and backlink as necessary.
71 Avoid adding to the new parent, since the position matters."
73   ch treeParent ifNotNilDo: #(remove: ch) `er.
74   ch treeParent := ot.
77 obj reparentTo: ot@(OrderedTree traits)
78 [].
80 ot@(OrderedTree traits) isLeaf: child
81 "Answer whether the given element would not count as a sub-tree of the
82 tree if it were a child of it - if it's anything but a tree itself."
83 [(child is: ot) not].
85 ot@(OrderedTree traits) at: index put: ch
87   ch reparentTo: ot.
88   ot children at: index put: ch.
89   ot
92 ot@(OrderedTree traits) addFirst: ch
94   ch reparentTo: ot.
95   ot children addFirst: ch.
96   ot
99 ot@(OrderedTree traits) addLast: ch
100 "Add a tree node as a child, and set the parent back-link."
102   ch reparentTo: ot.
103   ot children addLast: ch.
104   ot
107 ot@(OrderedTree traits) remove: ch
108 "Remove the tree node as a child, making sure to remove the parent link."
110   ot children remove: ch ifAbsent: [^ Nil].
111   ch reparentTo: Nil.
112   ot
115 ot@(OrderedTree traits) remove: ch ifAbsent: block
117   ot children remove: ch ifAbsent: [block do]
120 collections define: #Trie
121             &parents: {OrderedTree. NoDuplicatesCollection. Mapping} &slots: {#element}.
122 "A trie is a Set of Sequences encoded as a left-to-right element search tree.
123 At nodes whose path represents a Sequence that is an element, the node is
124 tagged with the element. To use a Trie as a Set, the element should be the
125 Sequence itself, handled by the add:/remove: protocol; otherwise it can be
126 used as a Dictionary."
127 "element: Records the element that the trie node encodes, if it does at all. The
128 element should consist of the sequence of all the keys used in order to access
129 the given node. As a result, trie nodes must be root-aware."
130 Trie children := IdentityDictionary new.
131 "Uses a Mapping of Sequence elements to the next Node."
133 t@(Trie traits) new &capacity: n
134 "Tries are generally 'narrow' Trees."
135 [n ifNil: [n := 3]. resend].
137 t@(Trie traits) acceptsKey: _
138 [False].
140 t@(Trie traits) acceptsKey: _@(Sequence traits)
141 "This is not quite true, since any key will work that responds to at:
142 appropriately when given 0..n of integers and has a size."
143 [True].
145 t@(Trie traits) includes: s@(Sequence traits)
146 "Treat the trie as a set of its keys. Searching for values is more expensive."
148   (t at: s) isNotNil
151 t@(Trie traits) size
153   t children
154     inject: t children size
155     into: [| :sum :each | sum + each size]
158 t@(Trie traits) nodeFor: seq
159 "Returns the Trie node for the given Sequence."
160 [| here |
161   here := t.
162   seq do: [| :each | here := here children at: each ifAbsent: []].
163   here
166 t@(Trie traits) at: s@(Sequence traits)
167 "Search from here each of the elements of the sequence in turn."
169   (t nodeFor: s) ifNotNilDo: #element `er
172 t@(Trie traits) nearestNodeFor: seq
173 "Returns the Trie node that completes the greatest part of the Sequence."
174 [| here next cursor |
175   here := t.
176   next := t.
177   cursor := 0.
178   [next isNil] whileFalse:
179     [next := (here children at: (seq at: cursor) ifAbsent: []).
180      next ifNotNil: [here := next. cursor += 1]].
181   here
184 t@(Trie traits) at: s@(Sequence traits) put: obj
185 "Traverse down the Trie, adding nodes once an element isn't found.
186 Annotate the final node with the given element."
187 [| here next cursor |
188   here := t.
189   next := t.
190   cursor := 0.
191   [next isNil \/ [cursor = s size]] whileFalse:
192     [next := (here children at: (s at: cursor) ifAbsent: []).
193      next ifNotNil: [here := next. cursor += 1]].
194   "here is now at the last existing relevant Trie node.
195   cursor is the index within the Sequence of the next element to add."
196   cursor below: s size do:
197     [| :index |
198       next := t new.
199       here children at: (s at: index) put: next.
200       next treeParent := here.
201       here := next].
202   here element := obj.
203   obj
206 t@(Trie traits) add: s@(Sequence traits)
207 "Treat the trie as a Set."
209   t at: s put: s
212 t@(Trie traits) remove: s@(Sequence traits)
213 "Search the trie for the sequence, stop at the last found, then recursively
214 delete nodes with no element but the argument and move back up the tree.
215 This returns the keyed value if there is one."
216 [| next here lastPoint |
217   here := t.
218   next := t.
219   lastPoint := 0.
220   [next isNil] whileFalse:
221     [s doWithIndex: [| :each :index |
222      next := (here children at: each ifAbsent: []).
223      next ifNotNil: [lastPoint := index. here := next]]].
224   here element := Nil.
225   [here element isNil /\ [here children size <= 1]] whileTrue:
226     [| temp |
227      temp := here.
228      here := here treeParent.
229      here ifNil: [^ s]
230           ifNotNil: [here children keysAndValuesRemove:
231               [| :key :value | value == temp].
232             temp treeParent := Nil]].
233   s