Cons.st
author Claus Gittinger <cg@exept.de>
Thu, 05 Jun 2003 20:39:20 +0200
changeset 1237 3814a1f983a5
parent 1074 cb147ae2e03c
child 1243 15058ebc321b
permissions -rw-r--r--
*** empty log message ***

"
 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
    or:
        Cons car:a cdr:b

    Conses are not heavily used by Smalltalk (actually: not at all).
    Consider this mostly a demo class.


    [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.

    "
     Cons fromArray:#(1 2 3 4)   
     Cons fromArray:#()    
     Cons fromArray:#(1)    
    "
! !

!Cons methodsFor:'accessing'!

at:n
    "for collection compatibility:
     a slow indexed accessor"

    ^ (self nth:n) car

    "
     (Cons fromArray:#(1))       at:1     
     (Cons fromArray:#(1 2 3 4)) at:1 
     (Cons fromArray:#(1 2 3 4)) at:3  
     (Cons fromArray:#(1 2 3 4)) at:4  
     (Cons fromArray:#(1 2 3 4)) at:5  
    "
!

at:n put:newValue
    "for collection compatibility:
     a slow indexed accessor"

    (self nth:n) car:newValue.
    ^ newValue.

    "
     |l|

     l := Cons fromArray:#(1 2 3 4).
     l at:1 put:'one'.
     l at:3 put:'three'.
     l       
    "
!

head
    "return the head, first or car - whatever you wonna call it"

    ^ self car
!

last
    "for lispers:
     return the last element of a list"

    |p rest|

    p := self.
    [(rest := p cdr) notNil] whileTrue:[
        p := rest
    ].
    ^ p car

    "
     (Cons fromArray:#(1))       last     
     (Cons fromArray:#(1 2 3 4)) last    
    "
!

nth:n
    "for lispers:
     return the nth element of a list"

    |cnt p|

    cnt := n.
    p := self.
    [true] whileTrue:[
        cnt := cnt - 1.
        cnt == 0 ifTrue:[^ p car].
        p := p cdr.
        p isNil ifTrue:[
            self error:'no such element' mayProceed:true.
            ^ nil
        ].
    ].

    "
     (Cons fromArray:#(1))       nth:1     
     (Cons fromArray:#(1 2 3 4)) nth:1 
     (Cons fromArray:#(1 2 3 4)) nth:3  
     (Cons fromArray:#(1 2 3 4)) nth:4  
     (Cons fromArray:#(1 2 3 4)) nth:5  
    "
!

tail
    "return the tail, second or cdr - whatever you wonna call it"

    ^ self cdr
! !

!Cons methodsFor:'accessing - basic'!

car
    "return the head, first or car - whatever you wonna call it"

    ^ car
!

car:something
    "set the head, first or car - whatever you wonna call it"

    car := something.
!

car:carArg cdr:cdrArg 
    "set both car and cdr"

    car := carArg.
    cdr := cdrArg.
!

cdr
    "return the tail, second or cdr - whatever you wonna call it"

    ^ cdr
!

cdr:something
    "set the tail, second or cdr - whatever you wonna call it"

    cdr := something.
! !

!Cons methodsFor:'list processing'!

append:aCons
    "for lispers:
     append the arg. Return a new list, where the 2nd part is shared"

    |p rest|

    p := self.
    [(rest := p cdr) notNil] whileTrue:[
        p := rest
    ].
    p cdr:aCons.
    ^ self

    "
     (Cons fromArray:#(1 2 3 4)) 
        append:(Cons fromArray:#(5 6 7 8)) 
    "

    "sharing demonstrated:

     |a b ab|

     a := Cons fromArray:#(1 2 3 4).
     b := Cons fromArray:#(5 6 7 8).
     ab := a append:b.
     b car:'five'.
     ab    
    "
!

take:n
    "for lispers:
     take n elements from the list; return a new list"

    n > 0 ifTrue:[
        ^ Cons car:(self car) cdr:(self cdr take:n-1)
    ].
    ^ nil

    "
     (Cons fromArray:#(1 2 3 4)) take:3  
     (Cons fromArray:#(1)) take:0  
     (Cons fromArray:#()) take:3  
    "
! !

!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
    "for smalltalkers: the lists length"

    |l p rest|

    l := 1.
    p := self.
    [(rest := p cdr) notNil] whileTrue:[
        l := l + 1.
        p := rest
    ].
    ^ l

    "
     (Cons fromArray:#( )) size    
     (Cons fromArray:#(1)) size     
     (Cons fromArray:#(1 2 3 4)) size    
    "
! !

!Cons class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic2/Cons.st,v 1.4 2003-06-05 18:39:20 cg Exp $'
! !