moo/stix/kernel/Collect.st

327 lines
5.8 KiB
Smalltalk
Raw Normal View History

class Collection(Object)
{
}
2016-05-13 15:10:34 +00:00
## -------------------------------------------------------------------------------
class(#pointer) Array(Collection)
2016-05-13 15:10:34 +00:00
{
method size
2016-05-13 15:10:34 +00:00
{
^self basicSize
2016-05-13 15:10:34 +00:00
}
method at: anInteger
2016-05-13 15:10:34 +00:00
{
^self basicAt: anInteger.
}
method at: anInteger put: aValue
2016-05-13 15:10:34 +00:00
{
^self basicAt: anInteger put: aValue.
}
method first
2016-05-13 15:10:34 +00:00
{
^self at: 0.
}
method last
2016-05-13 15:10:34 +00:00
{
^self at: (self basicSize - 1).
2016-05-13 15:10:34 +00:00
}
method do: aBlock
2016-05-13 15:10:34 +00:00
{
0 priorTo: (self basicSize) do: [:i | aBlock value: (self at: i)].
2016-05-13 15:10:34 +00:00
}
method copy: anArray
2016-05-13 15:10:34 +00:00
{
0 priorTo: (anArray basicSize) do: [:i | self at: i put: (anArray at: i) ].
2016-05-13 15:10:34 +00:00
}
}
## -------------------------------------------------------------------------------
class(#character) String(Array)
2016-05-13 15:10:34 +00:00
{
method & string
2016-05-13 15:10:34 +00:00
{
(* 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) ].
2016-05-13 15:10:34 +00:00
^newstr
}
method asString
{
^self
}
2016-05-13 15:10:34 +00:00
}
## -------------------------------------------------------------------------------
class(#character) Symbol(String)
2016-05-13 15:10:34 +00:00
{
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.
}
2016-05-13 15:10:34 +00:00
}
## -------------------------------------------------------------------------------
class(#byte) ByteArray(Collection)
2016-05-13 15:10:34 +00:00
{
method at: anInteger
2016-05-13 15:10:34 +00:00
{
^self basicAt: anInteger.
}
method at: anInteger put: aValue
2016-05-13 15:10:34 +00:00
{
^self basicAt: anInteger put: aValue.
}
}
## -------------------------------------------------------------------------------
class Set(Collection)
2016-05-13 15:10:34 +00:00
{
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 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]
].
}
2016-05-13 15:10:34 +00:00
}
class SymbolSet(Set)
2016-05-13 15:10:34 +00:00
{
}
class Dictionary(Set)
2016-05-13 15:10:34 +00:00
{
}
pooldic Log
2016-05-13 15:10:34 +00:00
{
## -----------------------------------------------------------
## defines log levels
## these items must follow defintions in stix.h
## -----------------------------------------------------------
#DEBUG := 1.
#INFO := 2.
#WARN := 4.
#ERROR := 8.
#FATAL := 16.
2016-05-13 15:10:34 +00:00
}
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: 'argument is not a symbol'].
^super at: key.
}
}
2016-05-13 15:10:34 +00:00
class Namespace(Set)
2016-05-13 15:10:34 +00:00
{
}
class PoolDictionary(Set)
2016-05-13 15:10:34 +00:00
{
}
class MethodDictionary(Dictionary)
2016-05-13 15:10:34 +00:00
{
}
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
}
}