File: ArrayColl.st

package info (click to toggle)
gnu-smalltalk 3.2.4-2.1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 32,688 kB
  • ctags: 14,104
  • sloc: ansic: 87,424; sh: 22,729; asm: 8,465; perl: 4,513; cpp: 3,548; xml: 1,669; awk: 1,581; yacc: 1,357; makefile: 1,237; lisp: 855; lex: 843; sed: 258; objc: 124
file content (544 lines) | stat: -rw-r--r-- 15,961 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
"======================================================================
|
|   ArrayedCollection Method Definitions
|
|
 ======================================================================"

"======================================================================
|
| Copyright 1988,92,94,95,99,2000,2001,2002,2006,2007,2008,2009
| Free Software Foundation, Inc.
| Written by Steve Byrne.
|
| This file is part of the GNU Smalltalk class library.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
| 
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
| General Public License for more details.
| 
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LIB.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02110-1301, USA.  
|
 ======================================================================"



SequenceableCollection subclass: ArrayedCollection [
    
    <shape: #pointer>
    <category: 'Collections-Sequenceable'>
    <comment: 'My instances are objects that are generally fixed size, and are accessed
by an integer index.  The ordering of my instance''s elements is determined 
externally; I will not rearrange the order of the elements.'>

    ArrayedCollection class >> new: size withAll: anObject [
	"Answer a collection with the given size, whose elements are all set to
	 anObject"

	<category: 'instance creation'>
	^(self new: size)
	    atAllPut: anObject;
	    yourself
    ]

    ArrayedCollection class >> streamContents: aBlock [
	"Create a ReadWriteStream on an empty instance of the receiver;
	 pass the stream to aBlock, then retrieve its contents and
	 answer them."

	<category: 'instance creation'>
	| stream |
	stream := ReadWriteStream on: (self new: 10).
	stream truncate.
	aBlock value: stream.
	^stream contents
    ]

    ArrayedCollection class >> withAll: aCollection [
	"Answer a collection whose elements are the same as those in aCollection"

	<category: 'instance creation'>
	| anArrayedCollection index |
	anArrayedCollection := self new: aCollection size.
	index := 1.
	aCollection do: 
		[:each | 
		anArrayedCollection at: index put: each.
		index := index + 1].
	^anArrayedCollection
    ]

    ArrayedCollection class >> with: element1 [
	"Answer a collection whose only element is element1"

	<category: 'instance creation'>
	^(self new: 1)
	    at: 1 put: element1;
	    yourself
    ]

    ArrayedCollection class >> with: element1 with: element2 [
	"Answer a collection whose only elements are the parameters in the order
	 they were passed"

	<category: 'instance creation'>
	^(self new: 2)
	    at: 1 put: element1;
	    at: 2 put: element2;
	    yourself
    ]

    ArrayedCollection class >> with: element1 with: element2 with: element3 [
	"Answer a collection whose only elements are the parameters in the order
	 they were passed"

	<category: 'instance creation'>
	^(self new: 3)
	    at: 1 put: element1;
	    at: 2 put: element2;
	    at: 3 put: element3;
	    yourself
    ]

    ArrayedCollection class >> with: element1 with: element2 with: element3 with: element4 [
	"Answer a collection whose only elements are the parameters in the order
	 they were passed"

	<category: 'instance creation'>
	^(self new: 4)
	    at: 1 put: element1;
	    at: 2 put: element2;
	    at: 3 put: element3;
	    at: 4 put: element4;
	    yourself
    ]

    ArrayedCollection class >> with: element1 with: element2 with: element3 with: element4 with: element5 [
	"Answer a collection whose only elements are the parameters in the order
	 they were passed"

	<category: 'instance creation'>
	^(self new: 5)
	    at: 1 put: element1;
	    at: 2 put: element2;
	    at: 3 put: element3;
	    at: 4 put: element4;
	    at: 5 put: element5;
	    yourself
    ]

    ArrayedCollection class >> join: aCollection [
	"Where aCollection is a collection of SequenceableCollections,
	 answer a new instance with all the elements therein, in order."

	<category: 'instance creation'>
	| newInst start |
	newInst := self 
		    new: (aCollection inject: 0 into: [:size :each | size + each size]).
	start := 1.
	aCollection do: 
		[:subColl | 
		newInst 
		    replaceFrom: start
		    to: (start := start + subColl size) - 1
		    with: subColl].
	^newInst
    ]

    ArrayedCollection class >> join: aCollection separatedBy: sepCollection [
	"Where aCollection is a collection of SequenceableCollections,
	 answer a new instance with all the elements therein, in order,
	 each separated by an occurrence of sepCollection."

	<category: 'instance creation'>
	| newInst start |
	aCollection isEmpty ifTrue: [^self new: 0].
	newInst := self 
		    new: (aCollection inject: sepCollection size * (aCollection size - 1)
			    into: [:size :each | size + each size]).
	start := 1.
	aCollection do: 
		[:subColl | 
		newInst 
		    replaceFrom: start
		    to: (start := start + subColl size) - 1
		    with: subColl]
	    separatedBy: 
		[newInst 
		    replaceFrom: start
		    to: (start := start + sepCollection size) - 1
		    with: sepCollection].
	^newInst
    ]

    add: value [
	<category: 'basic'>
	self shouldNotImplement
    ]

    , aSequenceableCollection [
	"Answer a new instance of an ArrayedCollection containing all the elements
	 in the receiver, followed by all the elements in aSequenceableCollection"

	<category: 'basic'>
	^(self copyEmpty: self size + aSequenceableCollection size)
	    replaceFrom: 1
		to: self size
		with: self
		startingAt: 1;
	    replaceFrom: self size + 1
		to: self size + aSequenceableCollection size
		with: aSequenceableCollection
		startingAt: 1;
	    yourself
    ]

    atAll: keyCollection [
	"Answer a collection of the same kind returned by #collect:, that
	 only includes the values at the given indices. Fail if any of
	 the values in keyCollection is out of bounds for the receiver."

	<category: 'basic'>
	| result i |
	result := self copyEmptyForCollect: keyCollection size.
	i := 0.
	keyCollection do: [:key | result at: (i := i + 1) put: (self at: key)].
	^result
    ]

    copyFrom: start to: stop [
	"Answer a new collection containing all the items in the receiver from the
	 start-th and to the stop-th"

	<category: 'basic'>
	| len |
	stop < start 
	    ifTrue: 
		[stop = (start - 1) ifTrue: [^self copyEmpty: 0].
		^SystemExceptions.ArgumentOutOfRange 
		    signalOn: stop
		    mustBeBetween: start - 1
		    and: self size].
	len := stop - start + 1.
	^(self copyEmpty: len)
	    replaceFrom: 1
		to: len
		with: self
		startingAt: start;
	    yourself
    ]

    copyWithout: oldElement [
	"Answer a copy of the receiver to which all occurrences of oldElement are
	 removed"

	<category: 'basic'>
	| newCollection numOccurrences i |
	numOccurrences := 0.
	self 
	    do: [:element | element = oldElement ifTrue: [numOccurrences := numOccurrences + 1]].
	newCollection := self copyEmpty: self size - numOccurrences.
	i := 1.
	self do: 
		[:element | 
		element = oldElement 
		    ifFalse: 
			[newCollection at: i put: element.
			i := i + 1]].
	^newCollection
    ]

    copyWith: anElement [
	"Answer a new instance of an ArrayedCollection containing all the elements
	 in the receiver, followed by the single item anElement"

	<category: 'basic'>
	| result |
	^(self copyEmpty: self size + 1)
	    replaceFrom: 1
		to: self size
		with: self
		startingAt: 1;
	    at: self size + 1 put: anElement;
	    yourself
    ]

    select: aBlock [
	"Answer a new instance of an ArrayedCollection containing all the elements
	 in the receiver which, when passed to aBlock, answer true"

	<category: 'enumerating the elements of a collection'>
	| newCollection |
	newCollection := WriteStream on: self copyEmpty.
	self 
	    do: [:element | (aBlock value: element) ifTrue: [newCollection nextPut: element]].
	^newCollection contents
    ]

    reject: aBlock [
	"Answer a new instance of an ArrayedCollection containing all the elements
	 in the receiver which, when passed to aBlock, answer false"

	<category: 'enumerating the elements of a collection'>
	| newCollection |
	newCollection := WriteStream on: self copyEmpty.
	self 
	    do: [:element | (aBlock value: element) ifFalse: [newCollection nextPut: element]].
	^newCollection contents
    ]

    collect: aBlock [
	"Answer a new instance of an ArrayedCollection containing all the results
	 of evaluating aBlock passing each of the receiver's elements"

	<category: 'enumerating the elements of a collection'>
	| newCollection |
	newCollection := self copyEmptyForCollect.
	1 to: self size
	    do: [:i | newCollection at: i put: (aBlock value: (self at: i))].
	^newCollection
    ]

    with: aSequenceableCollection collect: aBlock [
	"Evaluate aBlock for each pair of elements took respectively from the receiver
	 and from aSequenceableCollection; answer a collection of the same
	 kind of the receiver, made with the block's return values. Fail if the
	 receiver has not the same size as aSequenceableCollection."

	<category: 'enumerating the elements of a collection'>
	| newCollection |
	self size = aSequenceableCollection size 
	    ifFalse: [^SystemExceptions.InvalidSize signalOn: aSequenceableCollection].
	newCollection := self copyEmpty.
	1 to: self size
	    do: 
		[:i | 
		newCollection at: i
		    put: (aBlock value: (self at: i) value: (aSequenceableCollection at: i))].
	^newCollection
    ]

    copyReplaceFrom: start to: stop withObject: anObject [
	"Answer a new collection of the same class as the receiver that contains the
	 same elements as the receiver, in the same order, except for elements from
	 index `start' to index `stop'.
	 
	 If start < stop, these are replaced by stop-start+1 copies of anObject.
	 Instead, If start = (stop + 1), then every element of the receiver
	 will be present in the answered copy; the operation will be an append if
	 stop is equal to the size of the receiver or, if it is not, an insert before
	 index `start'."

	<category: 'copying Collections'>
	| newSize end result |
	stop - start < -1 
	    ifTrue: 
		[^SystemExceptions.ArgumentOutOfRange 
		    signalOn: stop
		    mustBeBetween: start - 1
		    and: self size].

	end := stop >= start ifTrue: [ stop ] ifFalse: [ start ].
	^(self copyEmpty: (newSize := end + (self size - stop)))
	    replaceFrom: 1 to: start - 1 with: self startingAt: 1;
	    replaceFrom: start to: end withObject: anObject;
	    replaceFrom: end + 1 to: newSize with: self startingAt: stop + 1;
	    yourself
    ]

    copyReplaceAll: oldSubCollection with: newSubCollection [
	"Answer a new collection in which all the sequences matching
	 oldSubCollection are replaced with newSubCollection"

	<category: 'copying Collections'>
	| numOld newCollection sizeDifference newSubSize oldSubSize newStart oldStart copySize index |
	numOld := self countSubCollectionOccurrencesOf: oldSubCollection.
	newSubSize := newSubCollection size.
	oldSubSize := oldSubCollection size.
	sizeDifference := newSubSize - oldSubSize.
	newCollection := self copyEmpty: self size + (sizeDifference * numOld).
	oldStart := newStart := 1.
	
	[index := self 
		    indexOfSubCollection: oldSubCollection
		    startingAt: oldStart
		    ifAbsent: 
			["Copy the remaining part of self onto the tail of the new collection."

			newCollection 
			    replaceFrom: newStart
			    to: newCollection size
			    with: self
			    startingAt: oldStart.
			^newCollection].
	copySize := index - oldStart.
	newCollection 
	    replaceFrom: newStart
	    to: newStart + copySize - 1
	    with: self
	    startingAt: oldStart.
	newStart := newStart + copySize.
	newCollection 
	    replaceFrom: newStart
	    to: newStart + newSubSize - 1
	    with: newSubCollection
	    startingAt: 1.
	oldStart := oldStart + copySize + oldSubSize.
	newStart := newStart + newSubSize] 
		repeat
    ]

    copyReplaceFrom: start to: stop with: replacementCollection [
	"Answer a new collection of the same class as the receiver that contains the
	 same elements as the receiver, in the same order, except for elements from
	 index `start' to index `stop'.
	 
	 If start < stop, these are replaced by the contents of the
	 replacementCollection.  Instead, If start = (stop + 1), like in
	 `copyReplaceFrom: 4 to: 3 with: anArray', then every element of the receiver
	 will be present in the answered copy; the operation will be an append if
	 stop is equal to the size of the receiver or, if it is not, an insert before
	 index `start'."

	<category: 'copying Collections'>
	| newSize repSize |
	stop - start < -1 
	    ifTrue: 
		[^SystemExceptions.ArgumentOutOfRange 
		    signalOn: stop
		    mustBeBetween: start - 1
		    and: self size].
	repSize := replacementCollection size.
	newSize := self size + repSize - (stop - start + 1).
	^(self copyEmpty: newSize)
	    replaceFrom: 1 to: start - 1 with: self startingAt: 1;
	    replaceFrom: start to: start + repSize - 1 with: replacementCollection;
	    replaceFrom: start + repSize to: newSize with: self startingAt: stop + 1;
	    yourself
    ]

    reverse [
	"Answer the receivers' contents in reverse order"

	<category: 'copying Collections'>
	| result complement |
	result := self copyEmpty.
	complement := self size + 1.
	1 to: self size do: [:i | result at: i put: (self at: complement - i)].
	^result
    ]

    sorted [
	"Return a copy of the receiver sorted according to the default
	 sort block, which uses #<= to compare items."
        <category: 'sorting'>
	^self copyEmpty
	    replaceFrom: 1
	    to: self size
	    with: self asSortedCollection
	    startingAt: 1
    ]

    sorted: sortBlock [
	"Return a copy of the receiver sorted according to the given
	 sort block, which accepts pair of items and returns true if
	 the first item is less than the second one."
        <category: 'sorting'>
	^self copyEmpty
	    replaceFrom: 1
	    to: self size
	    with: (self asSortedCollection: sortBlock)
	    startingAt: 1
    ]

    storeOn: aStream [
	"Store Smalltalk code compiling to the receiver on aStream"

	<category: 'storing'>
	| index |
	aStream
	    nextPutAll: '((';
	    nextPutAll: self class storeString;
	    nextPutAll: ' basicNew: '.
	self basicSize printOn: aStream.
	aStream nextPut: $).
	index := 1.
	self do: 
		[:element | 
		aStream nextPutAll: ' at: '.
		index printOn: aStream.
		aStream nextPutAll: ' put: '.
		element storeOn: aStream.
		aStream nextPut: $;.
		index := index + 1].
	index > 1 ifTrue: [aStream nextPutAll: ' yourself'].
	aStream nextPut: $)
    ]

    copyEmpty [
	"Answer an empty copy of the receiver"

	<category: 'private'>
	^self copyEmpty: self size
    ]

    grow [
	"Private - Grow by some amount"

	<category: 'private'>
	self growBy: self growSize
    ]

    copyGrowTo: newSize [
	"Private - Answer a copy of the receiver grown to newSize elements"

	<category: 'private'>
	| newCollection |
	newCollection := self copyEmpty: newSize.
	newCollection 
	    replaceFrom: 1
	    to: self size
	    with: self
	    startingAt: 1.
	^newCollection
    ]

    growBy: delta [
	"Private - Make the receiver grow by delta elements"

	<category: 'private'>
	^self become: (self copyGrowTo: self basicSize + delta)
    ]

    growTo: newSize [
	"Private - Make the receiver grow to a size of newSize"

	<category: 'private'>
	^self become: (self copyGrowTo: newSize)
    ]

    writeStream [
	"Answer a WriteStream streaming on the receiver"

	<category: 'streams'>
	^WriteStream on: self
    ]

    size [
	"Answer the size of the receiver"

	<category: 'built ins'>
	<primitive: VMpr_Object_basicSize>
	
    ]
]