moo/stix/kernel/Collect.st
2017-01-06 13:27:49 +00:00

355 lines
6.4 KiB
Smalltalk

class Collection(Object)
{
}
## -------------------------------------------------------------------------------
class(#pointer) Array(Collection)
{
method size
{
^self basicSize
}
method at: anInteger
{
^self basicAt: anInteger.
}
method at: anInteger put: aValue
{
^self basicAt: anInteger put: aValue.
}
method first
{
^self at: 0.
}
method last
{
^self at: (self basicSize - 1).
}
method do: aBlock
{
0 priorTo: (self basicSize) do: [:i | aBlock value: (self at: i)].
}
method copy: anArray
{
0 priorTo: (anArray basicSize) do: [:i | self at: i put: (anArray at: i) ].
}
}
## -------------------------------------------------------------------------------
class(#character) String(Array)
{
method & string
{
(* TOOD: make this a primitive for performance. *)
(* concatenate two strings. *)
| newsize newstr cursize appsize |
cursize := self basicSize.
appsize := string basicSize.
newsize := cursize + appsize.
(*newstr := self class basicNew: newsize.*)
newstr := String basicNew: newsize.
0 priorTo: cursize do: [:i | newstr at: i put: (self at: i) ].
0 priorTo: appsize do: [:i | newstr at: (i + cursize) put: (string at: i) ].
^newstr
}
method asString
{
^self
}
}
## -------------------------------------------------------------------------------
class(#character) Symbol(String)
{
method asString
{
(* TODO: make this a primitive for performance *)
(* convert a symbol to a string *)
| size str |
size := self basicSize.
str := String basicNew: size.
0 priorTo: size do: [:i | str at: i put: (self at: i) ].
^str.
}
method = anObject
{
(* for a symbol, equality check is the same as the identity check *)
<primitive: #_identical>
self primitiveFailed.
}
method ~= anObject
{
(* for a symbol, equality check is the same as the identity check *)
<primitive: #_not_identical>
^(self == anObject) not.
}
}
## -------------------------------------------------------------------------------
class(#byte) ByteArray(Collection)
{
method at: anInteger
{
^self basicAt: anInteger.
}
method at: anInteger put: aValue
{
^self basicAt: anInteger put: aValue.
}
}
## -------------------------------------------------------------------------------
class Set(Collection)
{
dcl tally bucket.
method initialize
{
self.tally := 0.
self.bucket := Array new: 100.
}
method size
{
^self.tally
}
method at: key
{
| ass |
ass := self __find: key or_upsert: false with: nil.
(ass notNil) ifTrue: [^ass value].
^ErrorCode.NOENT
}
method at: key ifAbsent: error_block
{
| ass |
ass := self __find: key or_upsert: false with: nil.
(ass notNil) ifTrue: [^ass value].
^error_block value.
}
method at: key put: value
{
self __find: key or_upsert: true with: value.
^value
}
method __find: key or_upsert: upsert with: value
{
| hv ass bs index ntally |
bs := self.bucket size.
hv := key hash.
index := hv rem: bs.
[(ass := self.bucket at: index) notNil]
whileTrue: [
[key == ass key] ifTrue: [ (* TODO: change it to equality??? *)
(* found *)
upsert ifTrue: [ass value: value].
^ass
].
index := (index + 1) rem: bs.
].
upsert ifFalse: [^nil].
ntally := self.tally + 1.
(ntally >= bs) ifTrue: [
(* expand the bucket *)
].
ass := Association key: key value: value.
self.tally := ntally.
self.bucket at: index put: ass.
^ass
}
method do: block
{
| bs |
bs := self.bucket size.
0 priorTo: bs by: 1 do: [:i |
| ass |
(ass := self.bucket at: i) notNil ifTrue: [block value: ass value]
].
}
method keysDo: block
{
| bs |
bs := self.bucket size.
0 priorTo: bs by: 1 do: [:i |
| ass |
(ass := self.bucket at: i) notNil ifTrue: [block value: ass key]
].
}
method keysAndValuesDo: block
{
| bs |
bs := self.bucket size.
0 priorTo: bs by: 1 do: [:i |
| ass |
(ass := self.bucket at: i) notNil ifTrue: [block value: ass key value: ass value]
].
}
}
class SymbolSet(Set)
{
}
class Dictionary(Set)
{
}
pooldic Log
{
## -----------------------------------------------------------
## defines log levels
## these items must follow defintions in stix.h
## -----------------------------------------------------------
#DEBUG := 1.
#INFO := 2.
#WARN := 4.
#ERROR := 8.
#FATAL := 16.
}
class SystemDictionary(Dictionary)
{
## the following methods may not look suitable to be placed
## inside a system dictionary. but they are here for quick and dirty
## output production from the stix code.
## System logNl: 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'.
##
dcl(#pooldic) Log.
method atLevel: level log: message
{
<primitive: #_log>
## do nothing upon logging failure
}
method atLevel: level log: message and: message2
{
<primitive: #_log>
## do nothing upon logging failure
}
method atLevel: level log: message and: message2 and: message3
{
<primitive: #_log>
## do nothing upon logging failure
}
method atLevel: level logNl: message
{
## the #_log primitive accepts an array.
## so the following lines should work also.
## | x |
## x := Array new: 2.
## x at: 0 put: message.
## x at: 1 put: S'\n'.
## ^self atLevel: level log: x.
^self atLevel: level log: message and: S'\n'.
}
method atLevel: level logNl: message and: message2
{
^self atLevel: level log: message and: message2 and: S'\n'.
}
method log: message
{
^self atLevel: Log.INFO log: message.
}
method log: message and: message2
{
^self atLevel: Log.INFO log: message and: message2.
}
method logNl: message
{
^self atLevel: Log.INFO logNl: message.
}
method logNl: message and: message2
{
^self atLevel: Log.INFO logNl: message and: message2.
}
method at: key
{
(key class ~= Symbol) ifTrue: [InvalidArgumentException signal: 'key is not a symbol'].
^super at: key.
}
method at: key put: value
{
(key class ~= Symbol) ifTrue: [InvalidArgumentException signal: 'key is not a symbol'].
^super at: key put: value
}
}
class Namespace(Set)
{
}
class PoolDictionary(Set)
{
}
class MethodDictionary(Dictionary)
{
}
extend Apex
{
## -------------------------------------------------------
## Association has been defined now. let's add association
## creating methods
## -------------------------------------------------------
method(#class) -> object
{
^Association new key: self value: object
}
method -> object
{
^Association new key: self value: object
}
}