author | Claus Gittinger <cg@exept.de> |
Tue, 25 Jun 2019 11:09:04 +0200 | |
changeset 5048 | 63f42cfbaf59 |
parent 4932 | 571ac375933a |
permissions | -rw-r--r-- |
4672 | 1 |
"{ Encoding: utf8 }" |
2 |
||
1043 | 3 |
" |
4 |
COPYRIGHT (c) 2002 by eXept Software AG |
|
5 |
All Rights Reserved |
|
6 |
||
7 |
This software is furnished under a license and may be used |
|
8 |
only in accordance with the terms of that license and with the |
|
9 |
inclusion of the above copyright notice. This software may not |
|
10 |
be provided or otherwise made available to, or used by, any |
|
11 |
other person. No title to or ownership of the software is |
|
12 |
hereby transferred. |
|
13 |
" |
|
14 |
"{ Package: 'stx:libbasic2' }" |
|
15 |
||
4109 | 16 |
"{ NameSpace: Smalltalk }" |
17 |
||
1043 | 18 |
SequenceableCollection subclass:#Cons |
19 |
instanceVariableNames:'car cdr' |
|
20 |
classVariableNames:'' |
|
21 |
poolDictionaries:'' |
|
22 |
category:'Collections-Linked' |
|
23 |
! |
|
24 |
||
25 |
!Cons class methodsFor:'documentation'! |
|
26 |
||
27 |
copyright |
|
28 |
" |
|
29 |
COPYRIGHT (c) 2002 by eXept Software AG |
|
30 |
All Rights Reserved |
|
31 |
||
32 |
This software is furnished under a license and may be used |
|
33 |
only in accordance with the terms of that license and with the |
|
34 |
inclusion of the above copyright notice. This software may not |
|
35 |
be provided or otherwise made available to, or used by, any |
|
36 |
other person. No title to or ownership of the software is |
|
37 |
hereby transferred. |
|
38 |
" |
|
39 |
! |
|
40 |
||
41 |
documentation |
|
42 |
" |
|
43 |
A pair as in lisp. |
|
1074 | 44 |
Cons car:a cdr:b |
45 |
||
46 |
Conses are not heavily used by Smalltalk (actually: not at all). |
|
1377 | 47 |
Consider this a demo class. |
1043 | 48 |
|
49 |
[author:] |
|
2662 | 50 |
Claus Gittinger (Jun 2002) |
1043 | 51 |
|
52 |
[see also:] |
|
53 |
||
54 |
" |
|
1627 | 55 |
! |
56 |
||
57 |
examples |
|
58 |
" |
|
59 |
[exBegin] |
|
60 |
|p1 p2 p3| |
|
61 |
||
62 |
p3 := Cons car:3 cdr:nil. |
|
63 |
p2 := Cons car:2 cdr:p3. |
|
64 |
p1 := Cons car:1 cdr:p2. |
|
65 |
p1 head. |
|
66 |
p1 tail. |
|
67 |
p1 size. |
|
68 |
p1 do:[:each | Transcript showCR:each]. |
|
69 |
p1 at:2 |
|
70 |
[exEnd] |
|
71 |
" |
|
1043 | 72 |
! ! |
73 |
||
74 |
!Cons class methodsFor:'instance creation'! |
|
75 |
||
76 |
car:carArg cdr:cdrArg |
|
77 |
^ self basicNew car:carArg cdr:cdrArg |
|
78 |
! |
|
79 |
||
80 |
fromArray:anArray |
|
81 |
|p last first| |
|
82 |
||
83 |
anArray do:[:el | |
|
84 |
p := self car:el cdr:nil. |
|
85 |
first isNil ifTrue:[ |
|
86 |
first := p. |
|
87 |
] ifFalse:[ |
|
88 |
last cdr:p. |
|
89 |
]. |
|
90 |
last := p. |
|
91 |
]. |
|
92 |
^ first. |
|
93 |
||
94 |
" |
|
1074 | 95 |
Cons fromArray:#(1 2 3 4) |
96 |
Cons fromArray:#() |
|
97 |
Cons fromArray:#(1) |
|
1248 | 98 |
Cons fromArray:(1 to:10000) |
1043 | 99 |
" |
2556 | 100 |
! |
101 |
||
102 |
makeList:size |
|
103 |
|first prev this| |
|
104 |
||
105 |
size == 0 ifTrue:[^ nil]. |
|
2557
35bc2d58019d
comment/format in: #makeList:
Claus Gittinger <cg@exept.de>
parents:
2556
diff
changeset
|
106 |
|
2556 | 107 |
first := prev := self car:nil cdr:nil. |
108 |
2 to:size do:[:n | |
|
109 |
this := self car:nil cdr:nil. |
|
110 |
prev cdr:this. |
|
111 |
prev := this |
|
112 |
]. |
|
113 |
^ first |
|
114 |
||
115 |
" |
|
2557
35bc2d58019d
comment/format in: #makeList:
Claus Gittinger <cg@exept.de>
parents:
2556
diff
changeset
|
116 |
(self makeList:0) size |
35bc2d58019d
comment/format in: #makeList:
Claus Gittinger <cg@exept.de>
parents:
2556
diff
changeset
|
117 |
(self makeList:1) size |
2556 | 118 |
(self makeList:100) size |
119 |
(self makeList:1000) size |
|
120 |
(self makeList:10000) size |
|
121 |
" |
|
122 |
||
123 |
"Created: / 28-04-2011 / 00:37:11 / cg" |
|
2557
35bc2d58019d
comment/format in: #makeList:
Claus Gittinger <cg@exept.de>
parents:
2556
diff
changeset
|
124 |
"Modified: / 29-04-2011 / 10:38:11 / cg" |
1043 | 125 |
! ! |
126 |
||
2469 | 127 |
!Cons class methodsFor:'sExpressions'! |
128 |
||
3269 | 129 |
readLispAtomFrom:aStream |
130 |
|chars n| |
|
131 |
||
132 |
aStream skipSeparators. |
|
133 |
aStream atEnd ifTrue:[^ nil]. |
|
134 |
||
135 |
chars := aStream upToMatching:[:ch | ch isSeparator or:[ch = $( or:[ch = $)]]]. |
|
136 |
(n := Number readFromString:chars onError:nil) notNil ifTrue:[ |
|
137 |
"/ smalltalk allows +n; scheme does not |
|
138 |
(chars startsWith:'+') ifFalse:[ |
|
139 |
^ n |
|
140 |
]. |
|
141 |
]. |
|
142 |
^ chars asSymbol |
|
143 |
||
144 |
" |
|
145 |
self readLispFrom:('(cons 1 2)' readStream). |
|
146 |
self readLispFrom:('(cons 1+ 2)' readStream). |
|
147 |
self readLispFrom:('(cons +1 2)' readStream). |
|
148 |
" |
|
149 |
||
150 |
"Created: / 08-08-2010 / 17:15:18 / cg" |
|
151 |
! |
|
152 |
||
2469 | 153 |
readLispFrom:aStream |
4109 | 154 |
[ |
155 |
aStream skipSeparators. |
|
156 |
aStream atEnd ifTrue:[^ nil]. |
|
2470 | 157 |
|
4109 | 158 |
aStream peek ==$; ifFalse:[ |
159 |
aStream peek ==$( ifTrue:[ |
|
160 |
^ self readLispListFrom:aStream |
|
161 |
]. |
|
162 |
^ self readLispAtomFrom:aStream |
|
163 |
]. |
|
164 |
"/ EOL comment |
|
2469 | 165 |
aStream skipLine. |
4109 | 166 |
] loop |
167 |
||
2469 | 168 |
" |
169 |
self readLispFrom:('(cons 1 2)' readStream). |
|
170 |
" |
|
171 |
||
172 |
"Created: / 08-08-2010 / 17:07:49 / cg" |
|
173 |
! |
|
174 |
||
3269 | 175 |
readLispListFrom:aStream |
2469 | 176 |
|first this prev element| |
177 |
||
178 |
aStream next. "/ the leading '(' |
|
179 |
[ |
|
180 |
aStream skipSeparators. |
|
181 |
aStream peek ~= $) |
|
182 |
] whileTrue:[ |
|
183 |
element := self readLispFrom:aStream. |
|
4247 | 184 |
this := self car:element cdr:nil. |
2469 | 185 |
prev isNil ifTrue:[ |
186 |
first := this |
|
187 |
] ifFalse:[ |
|
188 |
prev cdr:this. |
|
189 |
]. |
|
190 |
prev := this. |
|
191 |
]. |
|
192 |
||
193 |
aStream next. "/ the trailing ')' |
|
194 |
^ first. |
|
195 |
||
196 |
" |
|
197 |
self readLispFrom:('(cons 1 2)' readStream). |
|
198 |
" |
|
199 |
||
200 |
"Modified: / 08-08-2010 / 17:15:54 / cg" |
|
201 |
! ! |
|
202 |
||
1043 | 203 |
!Cons methodsFor:'accessing'! |
204 |
||
205 |
at:n |
|
1074 | 206 |
"for collection compatibility: |
207 |
a slow indexed accessor" |
|
208 |
||
1627 | 209 |
^ (self nth:n) |
1043 | 210 |
|
211 |
" |
|
1074 | 212 |
(Cons fromArray:#(1)) at:1 |
213 |
(Cons fromArray:#(1 2 3 4)) at:1 |
|
214 |
(Cons fromArray:#(1 2 3 4)) at:3 |
|
215 |
(Cons fromArray:#(1 2 3 4)) at:4 |
|
216 |
(Cons fromArray:#(1 2 3 4)) at:5 |
|
1043 | 217 |
" |
218 |
! |
|
219 |
||
220 |
at:n put:newValue |
|
1627 | 221 |
"destructive: |
222 |
for collection compatibility: a slow indexed accessor" |
|
1074 | 223 |
|
1627 | 224 |
(self nthPair:n) car:newValue. |
1043 | 225 |
^ newValue. |
226 |
||
227 |
" |
|
228 |
|l| |
|
229 |
||
1074 | 230 |
l := Cons fromArray:#(1 2 3 4). |
1043 | 231 |
l at:1 put:'one'. |
232 |
l at:3 put:'three'. |
|
233 |
l |
|
234 |
" |
|
235 |
! |
|
236 |
||
1623 | 237 |
first |
238 |
"return the head, first or car - whatever you wonna call it" |
|
239 |
||
2469 | 240 |
^ car |
241 |
||
242 |
"Modified: / 08-08-2010 / 17:04:23 / cg" |
|
1623 | 243 |
! |
244 |
||
1237 | 245 |
head |
246 |
"return the head, first or car - whatever you wonna call it" |
|
247 |
||
2469 | 248 |
^ car |
249 |
||
250 |
"Modified: / 08-08-2010 / 17:04:20 / cg" |
|
1237 | 251 |
! |
252 |
||
1043 | 253 |
last |
1074 | 254 |
"for lispers: |
255 |
return the last element of a list" |
|
256 |
||
1043 | 257 |
|p rest| |
258 |
||
259 |
p := self. |
|
260 |
[(rest := p cdr) notNil] whileTrue:[ |
|
261 |
p := rest |
|
262 |
]. |
|
1237 | 263 |
^ p car |
1043 | 264 |
|
265 |
" |
|
1074 | 266 |
(Cons fromArray:#(1)) last |
267 |
(Cons fromArray:#(1 2 3 4)) last |
|
1043 | 268 |
" |
269 |
! |
|
270 |
||
271 |
nth:n |
|
1074 | 272 |
"for lispers: |
273 |
return the nth element of a list" |
|
274 |
||
1627 | 275 |
^ (self nthPair:n) car |
1043 | 276 |
|
277 |
" |
|
1074 | 278 |
(Cons fromArray:#(1)) nth:1 |
279 |
(Cons fromArray:#(1 2 3 4)) nth:1 |
|
280 |
(Cons fromArray:#(1 2 3 4)) nth:3 |
|
281 |
(Cons fromArray:#(1 2 3 4)) nth:4 |
|
282 |
(Cons fromArray:#(1 2 3 4)) nth:5 |
|
1248 | 283 |
(Cons fromArray:#( )) nth:1 -> error |
1043 | 284 |
" |
1237 | 285 |
! |
286 |
||
1623 | 287 |
rest |
2469 | 288 |
"return the tail, rest or cdr - whatever you wonna call it" |
1623 | 289 |
|
2469 | 290 |
^ cdr |
291 |
||
292 |
"Modified: / 08-08-2010 / 17:04:48 / cg" |
|
1623 | 293 |
! |
294 |
||
1243 | 295 |
reversed |
296 |
"for lispers: |
|
297 |
return a new list with the cars in reverse order" |
|
298 |
||
299 |
"/ for now, tail recursion is not yet optimized by the st/x jitter... |
|
300 |
"/ |
|
301 |
"/ |rev| |
|
302 |
"/ |
|
303 |
"/ rev := [:lst :acc | |
|
304 |
"/ lst isNil ifTrue:[ |
|
305 |
"/ acc |
|
306 |
"/ ] ifFalse:[ |
|
307 |
"/ rev value:(lst tail) |
|
308 |
"/ value:(Cons car:(lst head) cdr:acc) |
|
309 |
"/ ] |
|
310 |
"/ ]. |
|
311 |
"/ ^ rev value:self value:nil |
|
312 |
||
313 |
| lst acc| |
|
314 |
||
315 |
lst := self. |
|
316 |
acc := nil. |
|
317 |
||
318 |
[ |
|
319 |
|nLst nAcc| |
|
320 |
||
321 |
lst isNil ifTrue:[ ^ acc]. |
|
322 |
||
323 |
nLst := lst tail. |
|
324 |
nAcc := Cons car:(lst head) cdr:acc. |
|
325 |
lst := nLst. |
|
326 |
acc := nAcc. |
|
327 |
] loop |
|
328 |
||
329 |
" |
|
330 |
(Cons fromArray:#(1)) reversed |
|
331 |
(Cons fromArray:#(1 2)) reversed |
|
332 |
(Cons fromArray:#(1 2 3 4)) reversed |
|
333 |
(Cons fromArray:(1 to:10000)) reversed |
|
334 |
" |
|
335 |
! |
|
336 |
||
1237 | 337 |
tail |
2469 | 338 |
"return the tail, rest or cdr - whatever you wonna call it" |
1237 | 339 |
|
2469 | 340 |
^ cdr |
341 |
||
342 |
"Modified: / 08-08-2010 / 17:04:59 / cg" |
|
1043 | 343 |
! ! |
344 |
||
4537 | 345 |
!Cons methodsFor:'accessing-basic'! |
1043 | 346 |
|
2470 | 347 |
cadddr |
348 |
"return the fourth element" |
|
349 |
||
350 |
^ cdr cdr cdr car |
|
351 |
||
352 |
"Created: / 08-08-2010 / 17:29:40 / cg" |
|
353 |
! |
|
354 |
||
355 |
caddr |
|
356 |
"return the third element" |
|
357 |
||
358 |
^ cdr cdr car |
|
359 |
||
360 |
"Created: / 08-08-2010 / 17:29:32 / cg" |
|
361 |
! |
|
362 |
||
363 |
cadr |
|
364 |
"return the second element" |
|
365 |
||
366 |
^ cdr car |
|
367 |
||
368 |
"Created: / 08-08-2010 / 17:29:25 / cg" |
|
369 |
! |
|
370 |
||
1043 | 371 |
car |
1074 | 372 |
"return the head, first or car - whatever you wonna call it" |
1043 | 373 |
|
374 |
^ car |
|
375 |
! |
|
376 |
||
377 |
car:something |
|
1074 | 378 |
"set the head, first or car - whatever you wonna call it" |
1043 | 379 |
|
380 |
car := something. |
|
381 |
! |
|
382 |
||
383 |
car:carArg cdr:cdrArg |
|
1074 | 384 |
"set both car and cdr" |
1043 | 385 |
|
386 |
car := carArg. |
|
387 |
cdr := cdrArg. |
|
388 |
! |
|
389 |
||
2472 | 390 |
cddr |
391 |
"return the rest after the second element" |
|
392 |
||
393 |
^ cdr cdr |
|
394 |
||
395 |
"Created: / 08-08-2010 / 17:47:11 / cg" |
|
396 |
! |
|
397 |
||
1043 | 398 |
cdr |
1074 | 399 |
"return the tail, second or cdr - whatever you wonna call it" |
1043 | 400 |
|
401 |
^ cdr |
|
402 |
! |
|
403 |
||
404 |
cdr:something |
|
1074 | 405 |
"set the tail, second or cdr - whatever you wonna call it" |
1043 | 406 |
|
407 |
cdr := something. |
|
1623 | 408 |
! |
409 |
||
410 |
first:carArg rest:cdrArg |
|
411 |
"set both car and cdr" |
|
412 |
||
413 |
car := carArg. |
|
414 |
cdr := cdrArg. |
|
415 |
! |
|
416 |
||
417 |
head:carArg tail:cdrArg |
|
418 |
"set both car and cdr" |
|
419 |
||
420 |
car := carArg. |
|
421 |
cdr := cdrArg. |
|
1627 | 422 |
! |
423 |
||
424 |
nthPair:n |
|
425 |
"a helper: |
|
426 |
return the nth pair of a list" |
|
427 |
||
428 |
|cnt p| |
|
429 |
||
430 |
cnt := n. |
|
431 |
p := self. |
|
432 |
[ |
|
433 |
cnt := cnt - 1. |
|
434 |
cnt == 0 ifTrue:[^ p]. |
|
3310 | 435 |
|
1627 | 436 |
p := p cdr. |
437 |
p isNil ifTrue:[ |
|
438 |
self error:'no such element' mayProceed:true. |
|
439 |
^ nil |
|
440 |
]. |
|
441 |
] loop. |
|
442 |
! ! |
|
443 |
||
2437 | 444 |
!Cons methodsFor:'comparing'! |
445 |
||
446 |
= aCons |
|
447 |
^ aCons class == self class |
|
448 |
and:[ car = aCons car |
|
449 |
and:[ cdr = aCons cdr ]] |
|
450 |
! |
|
451 |
||
452 |
hash |
|
453 |
^ car hash bitXor: cdr hash |
|
454 |
! ! |
|
455 |
||
1627 | 456 |
!Cons methodsFor:'enumerating'! |
457 |
||
458 |
do:aBlock |
|
2471 | 459 |
"evaluate aBlock for each car" |
460 |
||
1627 | 461 |
|ptr| |
462 |
||
463 |
aBlock value:car. |
|
464 |
ptr := cdr. |
|
465 |
[ ptr notNil ] whileTrue:[ |
|
466 |
aBlock value:ptr car. |
|
467 |
ptr := ptr cdr. |
|
468 |
]. |
|
2471 | 469 |
|
470 |
"Modified: / 08-08-2010 / 17:33:44 / cg" |
|
1043 | 471 |
! ! |
472 |
||
473 |
!Cons methodsFor:'list processing'! |
|
474 |
||
475 |
append:aCons |
|
1074 | 476 |
"for lispers: |
1248 | 477 |
append the arg. Return a new list, where the 2nd part is shared. |
4672 | 478 |
Destructive: the receiver's last cdr is modified." |
1074 | 479 |
|
1043 | 480 |
|p rest| |
481 |
||
482 |
p := self. |
|
483 |
[(rest := p cdr) notNil] whileTrue:[ |
|
484 |
p := rest |
|
485 |
]. |
|
486 |
p cdr:aCons. |
|
487 |
^ self |
|
488 |
||
489 |
" |
|
1074 | 490 |
(Cons fromArray:#(1 2 3 4)) |
491 |
append:(Cons fromArray:#(5 6 7 8)) |
|
492 |
" |
|
493 |
||
494 |
"sharing demonstrated: |
|
495 |
||
496 |
|a b ab| |
|
497 |
||
498 |
a := Cons fromArray:#(1 2 3 4). |
|
499 |
b := Cons fromArray:#(5 6 7 8). |
|
500 |
ab := a append:b. |
|
501 |
b car:'five'. |
|
1248 | 502 |
ab |
503 |
" |
|
504 |
||
505 |
"destruction demonstrated: |
|
506 |
||
507 |
|a b ab| |
|
508 |
||
509 |
a := Cons fromArray:#(1 2 3 4). |
|
510 |
b := Cons fromArray:#(5 6 7 8). |
|
511 |
ab := a append:b. |
|
512 |
a |
|
1043 | 513 |
" |
1237 | 514 |
! |
515 |
||
1248 | 516 |
take:nTaken |
1237 | 517 |
"for lispers: |
518 |
take n elements from the list; return a new list" |
|
519 |
||
1248 | 520 |
|nRemain l rslt lastCons cons| |
521 |
||
522 |
nTaken > 0 ifTrue:[ |
|
523 |
"/ avoiding recursion here... |
|
524 |
"/ instead of: |
|
525 |
"/ ^ Cons car:(self car) cdr:(self cdr take:nTaken-1) |
|
526 |
"/ we do: |
|
527 |
nRemain := nTaken. |
|
528 |
l := self. |
|
529 |
rslt := lastCons := Cons car:(l car) cdr:nil. |
|
530 |
[nRemain > 1] whileTrue:[ |
|
531 |
l := l cdr. |
|
532 |
cons := Cons car:(l car) cdr:nil. |
|
533 |
lastCons cdr:cons. |
|
534 |
lastCons := cons. |
|
535 |
nRemain := nRemain - 1. |
|
536 |
]. |
|
537 |
^ rslt. |
|
1237 | 538 |
]. |
539 |
^ nil |
|
540 |
||
541 |
" |
|
542 |
(Cons fromArray:#(1 2 3 4)) take:3 |
|
543 |
(Cons fromArray:#(1)) take:0 |
|
544 |
(Cons fromArray:#()) take:3 |
|
1248 | 545 |
(Cons fromArray:(1 to: 1000)) take:999 |
2656 | 546 |
|
547 |
|gen allNumbers| |
|
548 |
gen := [:n | LazyCons car:n cdr:[ gen value:n+1 ]]. |
|
549 |
allNumbers := gen value:1. |
|
550 |
allNumbers take:10 |
|
1237 | 551 |
" |
2656 | 552 |
|
553 |
"Modified (comment): / 27-09-2011 / 11:31:38 / cg" |
|
1043 | 554 |
! ! |
555 |
||
556 |
!Cons methodsFor:'printing'! |
|
557 |
||
558 |
displayString |
|
559 |
^ self printString |
|
560 |
! |
|
561 |
||
562 |
printOn:aStream |
|
2448 | 563 |
thisContext isRecursive ifTrue:[ |
564 |
'Cons [error]: printOn: of self referencing collection.' errorPrintCR. |
|
565 |
aStream nextPutAll:'#("recursive")'. |
|
566 |
^ self. |
|
567 |
]. |
|
568 |
||
4932 | 569 |
aStream nextPutAll:'('. |
570 |
self printRestOn:aStream. |
|
571 |
||
572 |
"Modified: / 18-05-2010 / 10:25:49 / cg" |
|
573 |
"Modified: / 02-04-2019 / 23:59:15 / Claus Gittinger" |
|
574 |
! |
|
575 |
||
576 |
printRestOn:aStream |
|
577 |
thisContext isRecursive ifTrue:[ |
|
578 |
'Cons [error]: printOn: of self referencing collection.' errorPrintCR. |
|
579 |
aStream nextPutAll:'#("recursive")'. |
|
580 |
^ self. |
|
1043 | 581 |
]. |
582 |
||
4932 | 583 |
car printOn:aStream. |
584 |
cdr isNil ifTrue:[ |
|
1043 | 585 |
aStream nextPutAll:')'. |
4932 | 586 |
^ self. |
587 |
]. |
|
588 |
(cdr isLazyValue not and:[ cdr isCons ]) ifTrue:[ |
|
589 |
aStream nextPutAll:' '. |
|
590 |
cdr printRestOn:aStream. |
|
591 |
^ self. |
|
1043 | 592 |
]. |
4932 | 593 |
|
594 |
aStream nextPutAll:' . '. |
|
595 |
cdr printOn:aStream. |
|
596 |
aStream nextPutAll:')'. |
|
2448 | 597 |
|
4932 | 598 |
"Created: / 02-04-2019 / 23:55:05 / Claus Gittinger" |
1043 | 599 |
! ! |
600 |
||
601 |
!Cons methodsFor:'queries'! |
|
602 |
||
2753 | 603 |
beginAndSizeOfCycle |
3310 | 604 |
"return the begin and size of a cycle, if the list contains one. |
605 |
Nil otherwise. |
|
2753 | 606 |
Floyd's cycle-finding algorithm" |
607 |
||
608 |
|t h i loopStartIndex loopSize| |
|
609 |
||
610 |
t := self cdr. t isNil ifTrue:[^ nil]. |
|
611 |
h := t cdr. h isNil ifTrue:[^ nil]. |
|
612 |
||
613 |
[t ~~ h] whileTrue:[ |
|
614 |
t := t cdr. |
|
615 |
h := h cdr. h isNil ifTrue:[^ nil]. |
|
616 |
h := h cdr. h isNil ifTrue:[^ nil]. |
|
617 |
]. |
|
618 |
||
619 |
"/ both h and t are now inside the cycle, |
|
620 |
"/ equidistant from the start of the cycle |
|
621 |
t := self. |
|
622 |
i := 1. |
|
623 |
[t ~~ h] whileTrue:[ |
|
624 |
t := t cdr. |
|
625 |
h := h cdr. |
|
626 |
i := i + 1. |
|
627 |
]. |
|
628 |
loopStartIndex := i. |
|
629 |
||
630 |
loopSize := 1. |
|
631 |
h := t cdr. |
|
632 |
[t ~~ h] whileTrue:[ |
|
633 |
h := h cdr. |
|
634 |
i := i + 1. |
|
635 |
loopSize := loopSize + 1. |
|
636 |
]. |
|
637 |
||
638 |
^ { loopStartIndex. loopSize } |
|
639 |
||
640 |
" |
|
641 |
|n1 n2 n3 n4 n5| |
|
642 |
||
643 |
n1 := Cons new car:1. |
|
644 |
n2 := Cons new car:2. |
|
645 |
n3 := Cons new car:3. |
|
646 |
n4 := Cons new car:4. |
|
647 |
n5 := Cons new car:5. |
|
648 |
n1 cdr: n2. |
|
649 |
n2 cdr: n3. |
|
650 |
n3 cdr: n4. |
|
651 |
n4 cdr: n5. |
|
652 |
n1 beginAndSizeOfCycle. |
|
653 |
n5 cdr: n3. |
|
654 |
n1 beginAndSizeOfCycle. |
|
655 |
" |
|
656 |
||
657 |
"Created: / 27-07-2012 / 00:00:36 / cg" |
|
658 |
! |
|
659 |
||
660 |
isCyclic |
|
661 |
"true if the list contains a cycle" |
|
662 |
||
663 |
^ self beginAndSizeOfCycle notNil |
|
664 |
||
665 |
" |
|
666 |
|n1 n2 n3 n4 n5| |
|
667 |
||
668 |
n1 := Cons new car:1. |
|
669 |
n2 := Cons new car:2. |
|
670 |
n3 := Cons new car:3. |
|
671 |
n4 := Cons new car:4. |
|
672 |
n5 := Cons new car:5. |
|
673 |
n1 cdr: n2. |
|
674 |
n2 cdr: n3. |
|
675 |
n3 cdr: n4. |
|
676 |
n4 cdr: n5. |
|
677 |
n1 isCyclic. |
|
678 |
n5 cdr: n3. |
|
679 |
n1 isCyclic. |
|
680 |
" |
|
681 |
||
682 |
"Created: / 26-07-2012 / 23:32:52 / cg" |
|
683 |
! |
|
684 |
||
3310 | 685 |
size |
3307 | 686 |
"the list's length" |
1074 | 687 |
|
3307 | 688 |
|len p rest| |
1043 | 689 |
|
3307 | 690 |
len := 1. |
1043 | 691 |
p := self. |
3309 | 692 |
|
3310 | 693 |
[ |
694 |
p isLazyValue not |
|
4526 | 695 |
and:[ (rest := p cdr) isCons ] |
3310 | 696 |
] whileTrue:[ |
3307 | 697 |
len := len + 1. |
1043 | 698 |
p := rest |
699 |
]. |
|
3307 | 700 |
^ len |
701 |
||
702 |
" |
|
3310 | 703 |
(Cons fromArray:#(1)) size |
1074 | 704 |
(Cons fromArray:#(1 2 3 4)) size |
3310 | 705 |
(Cons car:1 cdr:2) size --> error (degenerated list) |
1043 | 706 |
" |
4526 | 707 |
|
708 |
"Modified: / 25-10-2017 / 12:43:38 / cg" |
|
1043 | 709 |
! ! |
710 |
||
1377 | 711 |
!Cons methodsFor:'streaming'! |
712 |
||
713 |
readStream |
|
714 |
^ ConsStream on:self. |
|
715 |
! ! |
|
716 |
||
3310 | 717 |
!Cons methodsFor:'testing'! |
718 |
||
719 |
isCons |
|
720 |
^ true |
|
721 |
! |
|
722 |
||
723 |
isLazy |
|
724 |
^ false |
|
725 |
! ! |
|
726 |
||
1043 | 727 |
!Cons class methodsFor:'documentation'! |
728 |
||
729 |
version |
|
4109 | 730 |
^ '$Header$' |
2437 | 731 |
! |
732 |
||
733 |
version_CVS |
|
4109 | 734 |
^ '$Header$' |
1043 | 735 |
! ! |
3269 | 736 |