Cons.st
changeset 1043 544a0829a59b
child 1073 1b0886e40a5a
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Cons.st	Fri Jun 07 17:27:31 2002 +0200
@@ -0,0 +1,250 @@
+"
+ COPYRIGHT (c) 2002 by eXept Software AG
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+"{ Package: 'stx:libbasic2' }"
+
+SequenceableCollection subclass:#Cons
+	instanceVariableNames:'car cdr'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Collections-Linked'
+!
+
+!Cons class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2002 by eXept Software AG
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+    A pair as in lisp.
+    Create with:
+        a # b
+
+    [author:]
+        Claus Gittinger
+
+    [see also:]
+
+"
+! !
+
+!Cons class methodsFor:'instance creation'!
+
+car:carArg cdr:cdrArg
+    ^ self basicNew car:carArg cdr:cdrArg
+!
+
+fromArray:anArray
+    |p last first|
+
+    anArray do:[:el |
+        p := self car:el cdr:nil.
+        first isNil ifTrue:[
+            first := p.
+        ] ifFalse:[
+            last cdr:p.
+        ].
+        last := p.
+    ].
+    ^ first.
+
+    "
+     self fromArray:#(1 2 3 4)
+     self fromArray:#()    
+     self fromArray:#(1)    
+    "
+! !
+
+!Cons methodsFor:'accessing'!
+
+at:n
+    ^ (self nth:n) car
+
+    "
+     (self fromArray:#(1))       at:1     
+     (self fromArray:#(1 2 3 4)) at:1 
+     (self fromArray:#(1 2 3 4)) at:3  
+     (self fromArray:#(1 2 3 4)) at:4  
+     (self fromArray:#(1 2 3 4)) at:5  
+    "
+!
+
+at:n put:newValue
+    (self nth:n) car:newValue.
+    ^ newValue.
+
+    "
+     |l|
+
+     l := self fromArray:#(1 2 3 4).
+     l at:1 put:'one'.
+     l at:3 put:'three'.
+     l       
+    "
+!
+
+last
+    |p rest|
+
+    p := self.
+    [(rest := p cdr) notNil] whileTrue:[
+        p := rest
+    ].
+    ^ p
+
+    "
+     (self fromArray:#(1))       last     
+     (self fromArray:#(1 2 3 4)) last    
+    "
+!
+
+nth:n
+    |cnt p|
+
+    cnt := n.
+    p := self.
+    [true] whileTrue:[
+        cnt := cnt - 1.
+        cnt == 0 ifTrue:[^ p].
+        p := p cdr.
+        p isNil ifTrue:[
+            self error:'no such element' mayProceed:true.
+            ^ nil
+        ].
+    ].
+
+    "
+     (self fromArray:#(1))       nth:1     
+     (self fromArray:#(1 2 3 4)) nth:1 
+     (self fromArray:#(1 2 3 4)) nth:3  
+     (self fromArray:#(1 2 3 4)) nth:4  
+     (self fromArray:#(1 2 3 4)) nth:5  
+    "
+! !
+
+!Cons methodsFor:'accessing - basic'!
+
+car
+    "return the value of the instance variable 'car' (automatically generated)"
+
+    ^ car
+!
+
+car:something
+    "set the value of the instance variable 'car' (automatically generated)"
+
+    car := something.
+!
+
+car:carArg cdr:cdrArg 
+    "set instance variables (automatically generated)"
+
+    car := carArg.
+    cdr := cdrArg.
+!
+
+cdr
+    "return the value of the instance variable 'cdr' (automatically generated)"
+
+    ^ cdr
+!
+
+cdr:something
+    "set the value of the instance variable 'cdr' (automatically generated)"
+
+    cdr := something.
+! !
+
+!Cons methodsFor:'list processing'!
+
+append:aCons
+    |p rest|
+
+    p := self.
+    [(rest := p cdr) notNil] whileTrue:[
+        p := rest
+    ].
+    p cdr:aCons.
+    ^ self
+
+    "
+     (self fromArray:#(1 2 3 4)) append:(self fromArray:#(5 6 7 8))    
+    "
+! !
+
+!Cons methodsFor:'printing'!
+
+displayString
+    ^ self printString
+!
+
+printOn:aStream
+    (car isLazyValue not and:[ car isCons ]) ifTrue:[
+        aStream nextPutAll:'('.
+        car printOn:aStream.
+        aStream nextPutAll:')'.
+    ] ifFalse:[
+        car printOn:aStream.
+    ].
+
+    aStream nextPutAll:'#'.
+
+    (cdr isLazyValue not and:[ cdr isCons ]) ifTrue:[
+        aStream nextPutAll:'('.
+        cdr printOn:aStream.
+        aStream nextPutAll:')'.
+    ] ifFalse:[
+        cdr printOn:aStream.
+    ].
+! !
+
+!Cons methodsFor:'queries'!
+
+isCons
+    ^ true
+!
+
+size
+    |l p rest|
+
+    l := 1.
+    p := self.
+    [(rest := p cdr) notNil] whileTrue:[
+        l := l + 1.
+        p := rest
+    ].
+    ^ l
+
+    "
+     (self fromArray:#( )) size 
+     (self fromArray:#(1)) size     
+     (self fromArray:#(1 2 3 4)) size    
+    "
+! !
+
+!Cons class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic2/Cons.st,v 1.1 2002-06-07 15:27:31 cg Exp $'
+! !