Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/116.lha/SmallTalk/Sources/BASIC.ST

Text File | 1986-11-20 | 24.1 KB | 1,187 lines

*
* Little Smalltalk, version 2
* Written by Tim Budd, Oregon State University, July 1987
*
* basic classes common to all images
*
Declare Object
Declare Block Object context argumentCounter argumentLocation bytecodeCounter creatingInterpreter
Declare Boolean Object
Declare   True Boolean
Declare   False Boolean
Declare Class Object name instanceSize methods superClass variables icon
Declare Context Object method methodClass arguments temporaries
Declare Link Object key value nextLink
Declare Magnitude Object
Declare    Char Magnitude value
Declare    Collection Magnitude
Declare       IndexedCollection Collection
Declare          Array IndexedCollection
Declare             ByteArray Array
Declare                String ByteArray
Declare          Dictionary IndexedCollection hashTable
Declare       Interval Collection lower upper step
Declare       List Collection links
Declare          Set List
Declare    Number Magnitude
Declare       Integer Number
Declare       Float Number
Declare Method Object text message bytecodes literals stackSize temporarySize
Declare Random Object
Declare Switch Object const notdone
Declare Smalltalk Object
Declare Symbol Object
Declare UndefinedObject Object
*
Instance Smalltalk smalltalk
Instance True true
Instance False false
*
Class Object
    == aValue
        ^ <21 self aValue>
|
    = aValue
        ^ self == aValue
|
    basicAt: index
        ^ <25 self index>
|
    basicAt: index put: value
        ^ <31 self index value>
|
    basicSize
        ^ <12 self>
|
    class
        ^ <11 self>
|
    display
        ('(Class ', self class, ') ' , self printString ) print
|
    hash
        ^ <13 self>
|
    isMemberOf: aClass
        ^ self class == aClass
|
    isNil
        ^ false
|
    isKindOf: aClass
        self class upSuperclassChain:
            [:x | (x == aClass) ifTrue: [ ^ true ] ].
        ^ false
|
    new
            " default initialization protocol"
        ^ self
|
    notNil
        ^ true
|
    print
        ^ self printString print
|
    printString
        ^ self class printString
]
Class Array
    < coll
        (coll isKindOf: Array)
            ifTrue: [ self with: coll
                   do: [:x :y | (x < y) ifTrue: [ ^ true ]].
                  ^ self size < coll size ]
            ifFalse: [ ^ super < coll ]
|
    = coll
        (coll isKindOf: Array)
            ifTrue: [ (self size = coll size)
                    ifFalse: [ ^ false ].
                  self with: coll
                    do: [:x :y | (x = y)
                        ifFalse: [ ^ false ] ].
                 ^ true ]
            ifFalse: [ ^ super = coll ]
|
    at: index put: value
        (self includesKey: index)
            ifTrue: [ self basicAt: index put: value ]
            ifFalse: [ smalltalk error:
                'illegal index to at:put: for array' ]
|
    binaryDo: aBlock
        (1 to: self size) do:
            [:i | aBlock value: i value: (self at: i) ]
|
    copyFrom: low to: high    | newArray newlow newhigh |
        newlow <- low max: 1.
        newhigh <- high min: self size.
        newArray <- self class new: (0 max: newhigh - newlow + 1).
        (newlow to: newhigh)
            do: [:i |  newArray at: ((i - newlow) + 1)
                    put: (self at: i) ].
        ^ newArray
|
    do: aBlock
        (1 to: self size) do:
            [:i | aBlock value: (self at: i) ]
|
    exchange: a and: b    | temp |
        temp <- self at: a.
        self at: a put: (self at: b).
        self at: b put: temp
|
    includesKey: index
        ^ index between: 1 and: self size
|
    size
        ^ self basicSize
|
    with: coll do: aBlock
        (1 to: (self size min: coll size))
            do: [:i | aBlock value: (self at: i)
                    value: (coll at: i) ]
]
Class Block
    checkArgumentCount: count
        ^ (argumentCounter = count)
            ifTrue: [ true ]
            ifFalse: [ smalltalk error:
                'wrong number of arguments passed to block'.
                false ]
|
    value
        ^ (self checkArgumentCount: 0)
            ifTrue: [ context executeFrom: bytecodeCounter
                    creator: creatingInterpreter ]
|
    value: x
        ^ (self checkArgumentCount:  1)
            ifTrue: [ context temporaries at: argumentLocation
                    put: x.
                  context executeFrom: bytecodeCounter
                    creator: creatingInterpreter ]
|
    value: x value: y    | temps |
        ^ (self checkArgumentCount: 2)
            ifTrue: [ temps <- context temporaries.
                  temps at: argumentLocation put: x.
                  temps at: argumentLocation + 1 put: y.
                  context executeFrom: bytecodeCounter
                      creator: creatingInterpreter ]
|
    value: x value: y value: z    | temps |
        ^ (self checkArgumentCount:  3)
            ifTrue: [ temps <- context temporaries.
                  temps at: argumentLocation put: x.
                  temps at: argumentLocation + 1 put: y.
                  temps at: argumentLocation + 2 put: z.
                  context executeFrom: bytecodeCounter
                    creator: creatingInterpreter ]
|
    whileTrue: aBlock
        ( self value ) ifTrue:
            [ aBlock value.
                self whileTrue: aBlock ]
|
    whileTrue
        self whileTrue: []
]
Class Boolean
    ifTrue: trueBlock
        ^ self ifTrue: trueBlock ifFalse: []
|
    ifFalse: falseBlock
        ^ self ifTrue: [] ifFalse: falseBlock
|
    ifFalse: falseBlock ifTrue: trueBlock
        ^ self ifTrue: trueBlock
            ifFalse: falseBlock
|
    and: aBlock
        ^ self ifTrue: aBlock ifFalse: [ false ]
|
    or: aBlock
        ^ self ifTrue: [ true ] ifFalse: aBlock
]
Class ByteArray
    asString
        <22 self String>
|
    basicAt: index put: value
        ^ <32 self index value >
|
    basicAt: index
        ^ <26 self index>
|
    size: value
        ^ <22 <59 value> ByteArray>
|
    size
        ^ self basicSize * 2
]
Class Char
    < aValue
        ^ (aValue isMemberOf: Char)
            ifTrue: [ value < aValue asInteger ]
            ifFalse: [ smalltalk error: 'char compared to nonchar']
|
    == aValue
        ^ (aValue isMemberOf: Char)
            ifTrue: [ value = aValue asInteger ]
            ifFalse: [ false ]
|
    = aValue
        ^ self == aValue
|
    asInteger
        ^ value
|
    asString
        ^ ' ' copy; at: 1 put: self
|
    digitValue
        self isDigit ifTrue: [ ^ value - $0 asInteger ].
        self isUppercase ifTrue: [ ^ value - $A asInteger + 10 ].
        ^ smalltalk error: 'illegal conversion, char to digit'
|
    isAlphabetic
        ^ (self isLowercase) or: [ self isUppercase ]
|
    isAlphaNumeric
        ^ (self isAlphabetic) or: [ self isDigit ]
|
    isBlank
        ^ value = $   " blank char "
|
    isDigit
        ^ value between: $0 asInteger and: $9 asInteger
|
    isLowercase
        ^ value between: $a asInteger and: $z asInteger
|
    isUppercase
        ^ value between: $A asInteger and: $Z asInteger
|
    value: aValue        " private - used for initialization "
        value <- aValue
|
    printString
        ^ '$', self asString
]
Class Class
    new        | newObject |
        newObject <- self new: instanceSize.
        ^ (self == Class)
            ifTrue: [ newObject initialize ]
            ifFalse: [ newObject new ]
|
    new: size    " hack out block the right size and class "
        ^ < 22 < 58 size > self >
|
    initialize
        superClass <- Object.
        instanceSize <- 0.
        methods <- Dictionary new
|
    name
        ^ name
|
    name: aString
        name <- aString
|
    methods
        ^ methods
|
    instanceSize
        ^ instanceSize
|
    printString
        ^ name asString
|
    respondsTo    | theSet |
        theSet <- Set new.
        self upSuperclassChain:
            [:x | theSet addAll: x methods keys ].
        ^ theSet
|
    respondsTo: message
        ^ methods includesKey: message
|
    subClasses
        ^ globalNames inject: List new
            into: [:x :y | ((y class = Class) and:
                    [ y superClass = self])
                        ifTrue: [ x add: y]. x ]
|
    superClass
        ^ superClass
|
    superClass: aClass
        superClass <- aClass
|
    upSuperclassChain: aBlock
        aBlock value: self.
        (superClass notNil)
            ifTrue: [ superClass upSuperclassChain: aBlock ]
|
    variables
        ^ variables
|
    variables: nameArray
        variables <- nameArray.
        instanceSize <- superClass instanceSize + nameArray size
]
Class Collection
    < coll
        self do: [:x | (coll includes: x) ifFalse: [ ^ false ]].
        ^ true
|
    = coll
        self do: [:x | (self occurrencesOf: x) =
                (coll occurrencesOf: x) ifFalse: [ ^ false ] ].
        ^ true
|
    asArray        | newArray i |
        newArray <- Array new: self size.
        i <- 0.
        self do: [:x | i <- i + 1. newArray at: i put: x].
        ^ newArray
|
    asByteArray    | newArray i |
        newArray <- ByteArray new size: self size.
        i <- 0.
        self do: [:x | i <- i + 1. newArray at: i put: x].
        ^ newArray
|
    asSet
        ^ Set new addAll: self
|
    asString
        ^ self asByteArray asString
|
    display
        self do: [:x | x print ]
|
    includes: value
        self do: [:x | (x = value) ifTrue: [ ^ true ] ].
        ^ false
|
    inject: thisValue into: binaryBlock     | last |
        last <- thisValue.
        self do: [:x | last <- binaryBlock value: last value: x].
        ^ last
|
    isEmpty
        ^ self size == 0
|
    occurrencesOf: anObject
        ^ self inject: 0
               into: [:x :y | (y = anObject)
                     ifTrue: [x + 1]
                     ifFalse: [x] ]
|
    printString
        ^ ( self inject: self class printString , ' ('
             into: [:x :y | x , ' ' , y printString]), ' )'
|
    size
        ^ self inject: 0 into: [:x :y | x + 1]
|
    sort: aBlock
        ^ self inject: List new
            into: [:x :y | x add: y ordered: aBlock. x]
|
    sort
        ^ self sort: [:x :y | x < y ]
]
Class Context
    executeFrom: value creator: interp
        ^ <38 self value interp>
|
    method: value
        method <- value
|
    arguments: value
        arguments <- value
|
    temporaries
        ^ temporaries
|
    temporaries: value
        temporaries <- value
]
Class Dictionary
    new
        hashTable <- Array new: 39
|
    hash: aKey
        ^ 3 * ((aKey hash) rem: ((hashTable size) quo: 3))
|
    at: aKey ifAbsent: exceptionBlock    | hashPosition  link |

        hashPosition <- self hash: aKey.
        ((hashTable at: hashPosition + 1) == aKey)
            ifTrue: [ ^ hashTable at: hashPosition + 2].
        link <- hashTable at: hashPosition + 3.
        ^ (link notNil)
            ifTrue: [ link at: aKey ifAbsent: exceptionBlock ]
            ifFalse: exceptionBlock
|
    at: aKey put: aValue            | hashPosition link |

        hashPosition <- self hash: aKey.
        ((hashTable at: hashPosition + 1) isNil)
           ifTrue: [ hashTable at: hashPosition + 1 put: aKey ].
        ((hashTable at: hashPosition + 1) == aKey)
           ifTrue: [ hashTable at: hashPosition + 2 put: aValue ]
           ifFalse: [ link <- hashTable at: hashPosition + 3.
            (link notNil)
                ifTrue: [ link at: aKey put: aValue ]
                ifFalse: [ hashTable at: hashPosition + 3
                    put: (Link new; key: aKey; value: aValue)]]
|
    binaryDo: aBlock
        (1 to: hashTable size by: 3) do:
            [:i | (hashTable at: i) notNil
                ifTrue: [ aBlock value: (hashTable at: i)
                        value: (hashTable at: i+1) ].
                  (hashTable at: i+2) notNil
                ifTrue: [ (hashTable at: i+2)
                        binaryDo: aBlock ] ]
|
    display
        self binaryDo: [:x :y | (x printString , ' -> ',
                    y printString ) print ]
|
    includesKey: aKey
        " look up, but throw away result "
        self at: aKey ifAbsent: [ ^ false ].
        ^ true
|
    removeKey: aKey
        ^ self removeKey: aKey
            ifAbsent: [ smalltalk error: 'remove key not found']
|
    removeKey: aKey ifAbsent: exceptionBlock
        ^ (self includesKey: aKey)
            ifTrue: [ self basicRemoveKey: aKey ]
            ifFalse: exceptionBlock
|
    basicRemoveKey: aKey        | hashPosition link |
        hashPosition <- self hash: aKey.
        ((hashTable at: hashPosition + 1) == aKey)
            ifTrue: [ hashTable at: hashPosition + 1 put: nil.
                  hashTable at: hashPosition + 2 put: nil]
            ifFalse: [ link <- hashTable at: hashPosition + 3.
                (link notNil)
                    ifTrue: [ hashTable at: hashPosition + 3
                            put: (link removeKey: aKey) ]]
]
Class False
    ifTrue: trueBlock ifFalse: falseBlock
        ^ falseBlock value
|
    not
        ^ true
]
Class Float
    + value
        ^ (value isMemberOf: Float)
            ifTrue: [ <110 self value> ]
            ifFalse: [ super + value ]
|
    - value
        ^ (value isMemberOf: Float)
            ifTrue: [ <111 self value> ]
            ifFalse: [ super - value ]
|
    < value
        ^ (value isMemberOf: Float)
            ifTrue: [ <112 self value> ]
            ifFalse: [ super < value ]
|
    = value
        ^ (value isMemberOf: Float)
            ifTrue: [ <116 self value> ]
            ifFalse: [ super = value ]
|
    * value
        ^ (value isMemberOf: Float)
            ifTrue: [ <118 self value> ]
            ifFalse: [ super * value ]
|
    / value
        ^ (value isMemberOf: Float)
            ifTrue: [ (value = 0.0)
                    ifTrue: [ smalltalk error:
                        'float division by zero' ]
                    ifFalse: [ <119 self value> ]]
            ifFalse: [ super / value ]
|
    ceiling        | i |
        i <- self integerPart.
        ^ ((self positive) and: [ self ~= i ])
            ifTrue: [ i + 1 ]
            ifFalse: [ i ]
|
    coerce: value
        ^ value asFloat
|
    exp
        ^ <103 self>
|
    floor        | i |
        i <- self integerPart.
        ^ ((self negative) and: [ self ~= i ])
            ifTrue: [ i - 1 ]
            ifFalse: [ i ]
|
    fractionalPart
        ^ self - self integerPart
|
    generality
        ^ 7
|
    integerPart
        ^ <106 self>
|
    ln
        ^ <102 self>
|
    printString
        ^ <101 self>
|
    rounded
        ^ (self + 0.5 ) floor
|
    sqrt
        ^ (self negative)
            ifTrue: [ smalltalk error: 'sqrt of negative']
            ifFalse: [ <104 self> ]
|
    truncated
        ^ (self negative)
            ifTrue: [ self ceiling ]
            ifFalse: [ self floor ]
]
Class IndexedCollection
    addAll: aCollection
        aCollection binaryDo: [:i :x | self at: i put: x ]
|
    asArray
        ^ Array new: self size ; addAll: self
|
    asDictionary
        ^ Dictionary new ; addAll: self
|
    at: aKey
        ^ self at: aKey
            ifAbsent: [ smalltalk error: 'index to at: illegal' ]
|
    at: index ifAbsent: exceptionBlock
         ^ (self includesKey: index)
            ifTrue: [ self basicAt: index ]
            ifFalse: exceptionBlock
|
    binaryInject: thisValue into: aBlock     | last |
        last <- thisValue.
        self binaryDo: [:i :x | last <- aBlock value: last
                        value: i value: x].
        ^ last
|
    collect: aBlock
        ^ self binaryInject: Dictionary new
            into: [:s :i :x | s at: i put: (aBlock value: x).  s]
|
    do: aBlock
        self binaryDo: [:i :x | aBlock value: x ]
|
    keys
        ^ self binaryInject: Set new
            into: [:s :i :x | s add: i ]
|
    indexOf: aBlock
        ^ self indexOf: aBlock
            ifAbsent: [ smalltalk error: 'index not found']
|
    indexOf: aBlock ifAbsent: exceptionBlock
        self binaryDo: [:i :x | (aBlock value: x)
                ifTrue: [ ^ i ] ].
        ^ exceptionBlock value
|
    select: aBlock
        ^ self binaryInject: Dictionary new
            into: [:s :i :x | (aBlock value: x)
                    ifTrue: [ s at: i put: x ]. s ]
|
    values
        ^ self binaryInject: List new
            into: [:s :i :x | s add: x ]
]
Class Integer
    + value        | r |
        ^ (value isMemberOf: Integer)
            ifTrue: [ r <- <60 self value>.
                  r notNil ifTrue: [ r ]
                ifFalse: [ self asFloat + value asFloat ]]
            ifFalse: [ super + value ]
|
    - value        | r |
        ^ (value isMemberOf: Integer)
            ifTrue: [ r <- <61 self value>.
                r notNil ifTrue: [ r ]
                ifFalse: [ self asFloat - value asFloat ]]
            ifFalse: [ super - value ]
|
    < value
        ^ (value isMemberOf: Integer)
            ifTrue: [ <62 self value> ]
            ifFalse: [ super < value ]
|
    = value
        ^ (value isMemberOf: Integer)
            ifTrue: [ <66 self value> ]
            ifFalse: [ super = value ]
|
    * value        | r |
        ^ (value isMemberOf: Integer)
            ifTrue: [ r <- <68 self value>.
                  r notNil ifTrue: [ r ]
                  ifFalse: [ self asFloat * value asFloat ]]
            ifFalse: [ super * value ]
|
    / value        " do it as float "
        ^ self asFloat / value
|
    // value    | i |
        i <- self quo: value.
        ( (i < 0) and: [ (self rem: value) ~= 0] )
            ifTrue: [ i <- i - 1 ].
        ^ i
|
    \\ value
        ^ self * self sign rem: value
|
    allMask: value
        ^ value = (self bitAnd: value)
|
    anyMask: value
        ^ 0 ~= (self bitAnd: value)
|
    asCharacter
        ^ Char new; value: self
|
    asDigit
        (self >= 0)
            ifTrue: [ (self <= 9) ifTrue:
                    [ ^ (self + $0 asInteger) asCharacter ].
                  (self <= 36) ifTrue:
                    [ ^ (self + $A asInteger - 10) asCharacter ] ].
        ^ smalltalk error: 'illegal conversion, integer to digit'
|
    asFloat
        ^ <51 self>
|
    asString
        ^ self radix: 10
|
    bitAnd: value
        ^ (value isMemberOf: Integer)
            ifTrue: [ <71 self value > ]
            ifFalse: [ smalltalk error:
                'argument to bit operation must be integer']
|
    bitAt: value
        ^ (self bitShift: 1 - value) bitAnd: 1
|
    bitInvert
        ^ self bitXor: -1
|
    bitOr: value
        ^ (self bitXor: value) bitXor: (self bitAnd: value)
|
    bitXor: value
        ^ (value isMemberOf: Integer)
            ifTrue: [ <72 self value > ]
            ifFalse: [ smalltalk error:
                'argument to bit operation must be integer']
|
    bitShift: value
        ^ (value isMemberOf: Integer)
            ifTrue: [ <79 self value > ]
            ifFalse: [ smalltalk error:
                'argument to bit operation must be integer']
|
    even
        ^ (self rem: 2) = 0
|
    factorial
        ^ (2 to: self) inject: 1 into: [:x :y | x * y ]
|
    gcd: value
        (value = 0) ifTrue: [ ^ self ].
        (self negative) ifTrue: [ ^ self negated gcd: value ].
        (value negative) ifTrue: [ ^ self gcd: value negated ].
        (value > self) ifTrue: [ ^ value gcd: self ].
        ^ value gcd: (self rem: value)
|
    generality
        ^ 2
|
    lcm: value
        ^ (self quo: (self gcd: value)) * value
|
    odd
        ^ (self rem: 2) ~= 0
|
    quo: value    | r |
        ^ (value isMemberOf: Integer)
            ifTrue: [ r <- <69 self value>.
                (r isNil)
                    ifTrue: [ smalltalk error:
                        'quo: or rem: with argument 0']
                    ifFalse: [ r ]]
            ifFalse: [ smalltalk error:
                'argument to quo: or rem: must be integer']
|
    radix: base     | text |
        text <- (self \\ base) asDigit asString.
        ^ (self abs < base)
            ifTrue: [ (self negative)
                    ifTrue: [ '-' , text ]
                    ifFalse: [ text ]]
            ifFalse: [ ((self quo: base) radix: base), text ]
|
    rem: value
        ^ self - ((self quo: value) * value)
|
    printString
        ^ self asString
|
    timesRepeat: aBlock    | i |
        " use while, which is optimized, not to:, which is not"
        i <- 0.
        [ i < self ] whileTrue:
            [ aBlock value. i <- i + 1]
]
Class Interval
    do: aBlock        | current |
        current <- lower.
        (step > 0)
            ifTrue: [ [ current <= upper ] whileTrue:
                    [ aBlock value: current.
                      current <- current + step ] ]
            ifFalse: [ [ current >= upper ] whileTrue:
                    [ aBlock value: current.
                    current <- current + step ] ]
|
    lower: aValue
        lower <- aValue
|
    upper: aValue
        upper <- aValue
|
    step: aValue
        step <- aValue
]
Class Link
    add: newValue whenFalse: aBlock
        (aBlock value: value value: newValue)
            ifTrue: [ (nextLink notNil)
                ifTrue: [ nextLink <- nextLink add: newValue
                    whenFalse: aBlock ]
            ifFalse: [ nextLink <- Link new; value: newValue] ]
            ifFalse: [ ^ Link new; value: newValue; link: self ]
|
    at: aKey ifAbsent: exceptionBlock
        (aKey == key)
            ifTrue: [ ^value ]
            ifFalse: [ ^ (nextLink notNil)
                    ifTrue: [ nextLink at: aKey
                            ifAbsent: exceptionBlock ]
                    ifFalse: exceptionBlock ]
|
    at: aKey put: aValue
        (aKey == key)
            ifTrue: [ value <- aValue ]
            ifFalse: [ (nextLink notNil)
                ifTrue: [ nextLink at: aKey put: aValue]
                ifFalse: [ nextLink <- Link new;
                        key: aKey; value: aValue] ]
|
    binaryDo: aBlock
        aBlock value: key value: value.
        (nextLink notNil)
            ifTrue: [ nextLink binaryDo: aBlock ]
|
    key: aKey
        key <- aKey
|
    includesKey: aKey
        (key == aKey)
            ifTrue: [ ^ true ].
        (nextLink notNil)
            ifTrue: [ ^ nextLink includesKey: aKey ]
            ifFalse: [ ^ false ]
|
    link: aLink
        nextLink <- aLink
|
    removeKey: aKey
        (aKey == key)
            ifTrue: [ ^ nextLink ]
            ifFalse: [ (nextLink notNil)
                ifTrue: [ nextLink <- nextLink removeKey: aKey]]
|
    removeValue: aValue
        (aValue == value)
            ifTrue: [ ^ nextLink ]
            ifFalse: [ (nextLink notNil)
                ifTrue: [ nextLink <- nextLink removeValue: aValue]]
|
    size
        (nextLink notNil)
            ifTrue: [ ^ 1 + nextLink size]
            ifFalse: [ ^ 1 ]
|
    value: aValue
        value <- aValue
|
    value
        ^ value
]
Class List
    add: aValue
        ^ self addFirst: aValue
|
    add: aValue ordered: aBlock
        (links isNil)
            ifTrue: [ self addFirst: aValue]
            ifFalse: [ links <- links add: aValue
                    whenFalse: aBlock ]
|
    addAll: aValue
        aValue do: [:x | self add: x ]
|
    addFirst: aValue
        links <- Link new; value: aValue; link: links
|
    addLast: aValue
        (links isNil)
            ifTrue: [ self addFirst: aValue ]
            ifFalse: [ links add: aValue whenFalse: [ :x :y | true ] ]
|
    collect: aBlock
        ^ self inject: self class new
               into: [:x :y | x add: (aBlock value: y). x ]
|
    reject: aBlock
        ^ self select: [:x | (aBlock value: x) not ]
|
    select: aBlock
        ^ self inject: self class new
               into: [:x :y | (aBlock value: y)
                    ifTrue: [x add: y]. x]
|
    do: aBlock
        (links notNil)
            ifTrue: [ links binaryDo: [:x :y | aBlock value: y]]
|
    first
        ^ (links notNil)
            ifTrue: links
            ifFalse: [ smalltalk error: 'first on empty list']
|
    removeFirst
        self remove: self first
|
    remove: value
        (links notNil)
            ifTrue: [ links <- links removeValue: value ]
|
    size
        (links isNil)
            ifTrue: [ ^ 0 ]
            ifFalse: [ ^ links size ]
]
Class Magnitude
    <= value
        ^ (self < value) or: [ self = value ]
|
    < value
        ^ (value > self)
|
    >= value
        ^ (self > value) or: [ self = value ]
|
    > value
        ^ (value < self)
|
    = value
        ^ (self == value)
|
    ~= value
        ^ (self = value) not
|
    between: low and: high
        ^ (low <= self) and: [ self <= high ]
|
    max: value
        ^ (self < value)
            ifTrue: [ value ]
            ifFalse: [ self ]
|
    min: value
        ^ (self < value)
            ifTrue: [ self ]
            ifFalse: [ value ]
]
Class Method
    compileWithClass: aClass
        ^ <39 aClass text self>
|
    name
        ^ message
|
    message: aSymbol
        message <- aSymbol
|
    printString
        ^ message asString
|
    text
        ^ text
|
    text: aString
        text <- aString
|
    display
        ('Method ', message) print.
        'text' print.
        text print.
        'literals' print.
        literals print.
        'bytecodes' print.
        bytecodes do: [:x |
            (x printString, ' ', (x quo: 16), ' ', (x rem: 16))
                print ]
]
Class Number
    maxgen: value
        ^ (self generality > value generality)
            ifTrue: [ self ]
            ifFalse: [ value coerce: self ]
|
    + value
        ^ (self maxgen: value) + (value maxgen: self)
|
    - value
        ^ (self maxgen: value) - (value maxgen: self)
|
    < value
        ^ (self maxgen: value) < (value maxgen: self)
|
    = value
        ^ (self maxgen: value) = (value maxgen: self)
|
    * value
        ^ (self maxgen: value) * (value maxgen: self)
|
    / value
        ^ (self maxgen: value) / (value maxgen: self)
|
    abs
        ^ (self < 0)
            ifTrue: [ 0 - self ]
            ifFalse: [ self ]
|
    exp
        ^ self asFloat exp
|
    ln
        ^ self asFloat ln
|
    log: value
        ^ self ln / value ln
|
    negated
        ^ 0 - self
|
    negative
        ^ self < 0
|
    positive
        ^ self >= 0
|
    raisedTo: value
        ^ ( value * self ln ) exp
|
    reciprocal
        ^ 1.00 / self
|
    roundTo: value
        ^ (self / value ) rounded * value
|
    sign
        ^ self negative ifTrue: [ -1 ]
            ifFalse: [ self strictlyPositive
                    ifTrue: [ 1 ] ifFalse: [ 0 ] ]
|
    sqrt
        ^ self asFloat sqrt
|
    squared
        ^ self * self
|
    strictlyPositive
        ^ self > 0
|
    to: value
        ^ Interval new; lower: self; upper: value; step: 1
|
    to: value by: step
        ^ Interval new; lower: self; upper: value; step: step
|
    trucateTo: value
        ^ (self / value) trucated * value
]
Class Random
    between: low and: high
        ^ (self next * (high - low)) + low
|
    next
        ^ (<3> rem: 1000) / 1000
|
    next: value    | list |
        list <- List new.
        value timesRepeat: [ list add: self next ].
        ^ list
|
    randInteger: value
        ^ 1 + (<3> rem: value)
|
    set: value
        <55 value>
]
Class Set
    add: value
        (self includes: value)
            ifFalse: [ self addFirst: value ]
]
Class String
    , value
        ^ (value isMemberOf: String)
            ifTrue: [ (self size + value size) > 512
                    ifTrue: [ 'string too large' print.  self ]
                    ifFalse: [ <24 self value> ] ]
            ifFalse: [ self , value printString ]
|
    = value
        (value isKindOf: String)
            ifTrue: [ ^ super = value ]
            ifFalse: [ ^ false ]
|
    < value
        (value isKindOf: String)
            ifTrue: [ ^ super < value ]
            ifFalse: [ ^ false ]
|
    asInteger
        ^ self inject: 0 into: [:x :y | x * 10 + y digitValue ]
|
    basicAt: index
        ^  (super basicAt: index) asCharacter
|
    basicAt: index put: aValue
        (aValue isMemberOf: Char)
            ifTrue: [ super basicAt: index put: aValue asInteger ]
            ifFalse: [ smalltalk error:
                'cannot put non Char into string' ]
|
    asSymbol
        ^ <83 self>
|
    copy
        " catenation makes copy automatically "
        ^ '',self
|
    copyFrom: position1 to: position2
        ^ <33 self position1 position2>
|
    printString
        ^ '''' , self, ''''
|
    size
        ^ <81 self>
|
    words: aBlock    | text index list |
        list <- List new.
        text <- self.
        [ text <- text copyFrom:
            (text indexOf: aBlock ifAbsent: [ text size + 1])
                to: text size.
          text size > 0 ] whileTrue:
            [ index <- text
                indexOf: [:x | (aBlock value: x) not ]
                ifAbsent: [ text size + 1].
              list addLast: (text copyFrom: 1 to: index - 1).
              text <- text copyFrom: index to: text size ].
        ^ list asArray
]
Class Smalltalk
    class: aClass doesNotRespond: aMessage
        ^ self error: aClass printString ,
            ' does not respond to ' , aMessage
|
    cantFindGlobal: name
        ^ self error: 'cannot find global symbol ' , name
|
    flushMessageCache
        <2>
]
Class Switch
    key: value
        const <- value.
        notdone <- true.
|
    ifMatch: key do: block
        (notdone and: [ const = key ])
            ifTrue: [ notdone <- false. block value ]
|
    else: block
        notdone ifTrue: [ notdone <- false. block value ]
]
Class Symbol
    asString
        " catenation makes copy automatically "
        ^ <24 self ''>
|
    printString
        ^ '#' , self asString
|
    respondsTo
        ^ globalNames inject: Set new
            into: [:x :y | ((y class = Class) and:
                    [ y respondsTo: self])
                        ifTrue: [ x add: y]. x]
]
Class True
    ifTrue: trueBlock ifFalse: falseBlock
        ^ trueBlock value
|
    not
        ^ false
]
Class UndefinedObject
    isNil
        ^ true
|
    notNil
        ^ false
|
    printString
        ^ 'nil'
]