Tune hash resp. identityHash.
"
COPYRIGHT (c) 1988 by Claus Gittinger
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.
"
'From Smalltalk/X, Version:3.4.9 on 15-feb-1999 at 08:43:20' !
String variableByteSubclass:#Symbol
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Collections-Text'
!
!Symbol class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
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
"
Symbols represent unique strings - every symbol with same printString
exists exactly once in the system; Symbols are used for selectors, global
variable-keys etc. Symbols can also be used to represent things which are
enumeration type values in other programming languages (since symbols are
created at compile time, comparing them using == is a fast pointer compare).
A symbol may not change its characters - i.e. it is constant over its lifetime.
Other than that, symbols behave much like strings.
[author:]
Claus Gittinger
"
! !
!Symbol class methodsFor:'instance creation'!
basicNew:size
"redefined to return a string instead of a symbol -
this allows all copy methods inherited from String to
return strings containing the symbols characters.
Real symbols are only created with #intern: or #asSymbol."
^ String new:size
"Modified: 26.2.1996 / 12:51:38 / cg"
!
fromString:aString
"same as intern: for Symbol, but may be used to create interned instances
of subclasses.
Notice: this fails, if you try to intern an instance of a subclass, AND
a symbol with the same name already exists. In this case, the original
symbol is returned. To use it for enum-type symbols, make certain, that the
names are unique (for example by including the classes name as a prefix-string)."
|sym len|
sym := aString asSymbolIfInterned.
sym notNil ifTrue:[
^ sym
].
"
create a new uninterned instance first
"
len := aString size.
sym := super basicNew:len.
sym replaceFrom:1 to:len with:aString.
"now, intern it"
%{
sym = __INTERNSYMBOL(sym, (OBJ *)0, __context);
%}.
^ sym
!
intern:aString
"return a unique symbol with printname taken from the String-argument"
%{ /* NOCONTEXT */
OBJ newSymbol;
if (__isSymbol(aString)) {
RETURN (aString);
}
if (__isString(aString)) {
newSymbol = __MKSYMBOL(__stringVal(aString), (OBJ *)0);
if (newSymbol != nil) {
RETURN (newSymbol);
}
}
%}.
aString class ~~ String ifTrue:[
"/
"/ only allowed to intern strings
"/
^ self mustBeString
].
^ ObjectMemory allocationFailureSignal raise.
!
internCharacter:aCharacter
"return a unique symbol with printname taken from the Character-argument"
^ self intern:(aCharacter asString)
!
new:size
"redefined to return a string instead of a symbol -
this allows all copy methods inherited from String to
return strings containing the symbols characters.
Real symbols are only created with intern: or asSymbol."
^ String new:size
! !
!Symbol class methodsFor:'ST-80 compatibility'!
tableSize
"return the size of the systems symbol table"
"/ claus: I ont know, if the returned value should be exact.
^ 10000
"Created: 18.4.1997 / 20:52:20 / cg"
! !
!Symbol class methodsFor:'binary storage'!
binaryDefinitionFrom:stream manager:manager
"retrieve a symbol from a binary input stream (nonpublic interface)"
^ self intern:(super binaryDefinitionFrom:stream manager:manager)
"Modified: / 2.11.1997 / 16:17:06 / cg"
! !
!Symbol class methodsFor:'queries'!
findInterned:aString
"for ST-80 compatibility - if the argument, aString is known
as Symbol, return this symbol. Otherwise return nil."
^ aString asSymbolIfInterned
!
hasInterned:aString
"return true, if the argument, aString is known as Symbol;
false otherwise"
^ aString knownAsSymbol
!
hasInterned:aString ifTrue:trueBlock
"for ST-80 compatibility - if the argument, aString is known
as Symbol, evaluate the block with the corresponding symbol
as argument and return true; otherwise return false"
|sym|
(sym := aString asSymbolIfInterned) notNil ifTrue:[
trueBlock value:sym.
^ true
].
^ false
! !
!Symbol methodsFor:'accessing'!
basicAt:index put:something
"report an error if an interned symbol is about to be changed
- interned symbols may NOT be changed.
For uninterned symbols, this is allowed."
self knownAsSymbol ifTrue:[
self error:'interned symbols may not be changed'.
^ something
].
"
uninterned - allow change
"
^ super basicAt:index put:something
"Modified: 19.4.1996 / 11:16:10 / cg"
!
byteAt:index put:value
"report an error if interned - interned symbols may not be changed."
^ self basicAt:index put:(value asCharacter)
! !
!Symbol methodsFor:'binary storage'!
storeBinaryDefinitionOn:stream manager:manager
"append a binary representation of the receiver onto stream.
Redefined since short Symbol can be stored with a special type code
in a more compact way.
This is an internal interface for the binary storage mechanism."
|myClass myBasicSize|
"/ not for subclasses with named instVars.
(myClass := self class) instSize ~~ 0 ifTrue:[
^ super storeBinaryDefinitionOn:stream manager:manager
].
myBasicSize := self basicSize.
"/ can use a more compact representation;
"/ but not for subclasses ...
((myClass == Symbol)
and:[myBasicSize <= 255]) ifTrue:[
"/ special encoding: <codeForSymbol> <len> <bytes> ...
stream nextPut:(manager codeForSymbol); nextPut:myBasicSize.
] ifFalse:[
manager putIdOfClass:myClass on:stream.
stream nextNumber:4 put:myBasicSize.
].
stream nextPutBytes:myBasicSize from:self startingAt:1.
"Modified: / 2.11.1997 / 15:28:56 / cg"
"Created: / 2.11.1997 / 16:13:47 / cg"
! !
!Symbol methodsFor:'comparing'!
= something
"return true, if the receiver and argument consist of the same characters.
Redefined here, for more efficient #= comparison of symbols
(which ought to be compared using #==).
If the argument is a symbol, we use a quick pointer compare, instead of
the inherited value compare."
%{ /* NOCONTEXT */
OBJ cls;
if (! __isNonNilObject(something)) RETURN(false);
if ((cls = __qClass(something)) == Symbol) {
RETURN (self == something ? true : false);
}
if (cls == String) {
RETURN (strcmp(__stringVal(self), __stringVal(something)) == 0 ? true : false);
}
%}.
"fall back; could be a TwoByteString, or a collection of Characters"
^ super = something
!
identityHash
"interned symbols can return a better hash key"
%{ /* NOCONTEXT */
REGISTER unsigned int g, val;
REGISTER unsigned char *cp, *ce;
int l;
if (__Class(self) == Symbol) {
val = __GET_HASH(self);
/*
* only do it, if I have no standard hash key
* assigned (which can only happen due to a #become:,
* or by creating a symbol uninterned, and interning it
* after it got a hashKey assigned.
*/
if (val == 0) {
cp = __stringVal(self);
l = __stringSize(self);
/*
* this is the dragon-book algorithm
* We have tested 5-bit shifts as well:
*
* ST/X Symbols: 17807
* Hashkey collisions (4bit): 14 0.07%
* Hashkey collisions (5bit): 300 1.68%
*/
if (l > 0) {
val = cp[0];
if (l > 1) {
val = (val << 4) + cp[1];
if (l > 2) {
val = (val << 4) + cp[2];
if (l > 3) {
val = (val << 4) + cp[3];
if (l > 4) {
val = (val << 4) + cp[4];
if (l > 5) {
val = (val << 4) + cp[5];
if (l > 6) {
val = (val << 4) + cp[6];
for (ce = cp + l, cp += 7; cp < ce; cp++) {
if (g = (val & 0xF0000000)) {
val ^= g >> 24;
val ^= g;
}
val = (val << 4) + *cp;
}
}
}
}
}
}
}
} else {
val = 0;
}
val = (val * 31415821) & 0x3fffffff;
} else {
val = __MAKE_HASH__(val);
}
RETURN ( __MKSMALLINT(val) );
}
%}.
^ super identityHash
"
|hashColl hashSet|
hashColl := OrderedCollection new:20000.
Symbol allInstancesDo:[:instance |
hashColl add:instance identityHash
].
hashSet := hashColl asSet.
Transcript showCR:'Symbols: ', hashColl size printString,
' unique hash keys: ', hashSet size printString,
' collisions:', (hashColl size - hashSet size) printString.
"
!
~= something
"return true, if the receiver and argument do not consist of the same characters.
Redefined here, for more efficient #~= comparison of symbols
(which ought to be compared using #~~).
If the argument is a symbol, we use a quick pointer compare, instead of
the inherited value compare."
%{ /* NOCONTEXT */
OBJ cls;
if (! __isNonNilObject(something)) RETURN(true); /* cannot be equal */
if ((cls = __qClass(something)) == Symbol) {
RETURN (self == something ? false : true);
}
if (cls == String) {
RETURN (strcmp(__stringVal(self), __stringVal(something)) == 0 ? false : true);
}
%}.
"fall back; could be a TwoByteString, or a collection of Characters"
^ super ~= something
! !
!Symbol methodsFor:'converting'!
asString
"return a string with printname taken from mine"
%{ /* NOCONTEXT */
OBJ s;
s = __MKSTRING_ST(self);
if (s != nil) {
RETURN (s);
}
%}.
"
memory allocation (for the new string) failed.
When we arrive here, there was no memory, even after a garbage collect.
This means, that the VM wanted to get some more memory from the
OS, which was not kind enough to give it.
Bad luck - you should increase the swap space on your machine,
or if you have set a soft memoryLimit, increase it.
"
^ ObjectMemory allocationFailureSignal raise.
!
asSymbol
"return the receiver as a symbol.
Since I am a symbol - just return myself"
^ self
!
asSymbolIfInterned
"return the receiver as a symbol if there is one.
Since I am a symbol - just return myself"
^ self
!
decodeAsLiteralArray
"given a literalEncoding in the receiver,
create & return the corresponding object.
The inverse operation to #literalArrayEncoding."
^ self
"Created: 25.2.1997 / 19:15:26 / cg"
"Modified: 25.2.1997 / 19:17:40 / cg"
! !
!Symbol methodsFor:'copying'!
copy
"return a copy of myself
- reimplemented here since symbols are unique and copy should
return a new string with my characters."
^ self
!
copyReplaceAll:oldElement with:newElement
"return a copy of the receiver as a string, where all elements equal to oldElement
have been replaced by newElement."
^ self asString replaceAll:oldElement with:newElement
"Created: / 18.7.1998 / 23:03:38 / cg"
!
deepCopy
"return a copy of myself
- reimplemented here since symbols are unique and copy should
return a new string with my characters."
^ self
!
deepCopyUsing:aDictionary
"return a copy of myself
- reimplemented here since symbols are unique and copy should
return a new string with my characters."
^ self
!
shallowCopy
"return a copy of myself
- reimplemented here since symbols are unique"
^ self
!
simpleDeepCopy
"return a copy of myself
- reimplemented here since symbols are unique and copy should
return a new string with my characters."
^ self
! !
!Symbol methodsFor:'printing & storing'!
displayString
"return a string for displaying the receiver"
^ self storeString
!
printOn:aStream
"append a printed representation of the receiver on aStream.
In contrast to ST-80, this does return the symbols characters
without any leading #. Therefore, you can directly send symbols'
printStrings to some output device. This is incompatible, but easier
to use."
"/ ST-80 behavior:
"/ self storeOn:aStream
aStream nextPutAll:self
!
printString
"return a printed representation of the receiver.
In contrast to ST-80, this does return the symbols characters
without any leading #. Therefore, you can directly send symbols'
printStrings to some output device. This is incompatible, but easier
to use."
"/ ST-80 behavior:
"/ ^ self storeString
^ self asString
!
storeOn:aStream
"store myself on a stream"
aStream nextPutAll:(self storeString)
!
storeString
"return a String for storing the receiver"
|sz c|
(sz := self size) > 0 ifTrue:[ "/ sigh
(self at:1) isLetter ifTrue:[
2 to:sz do:[:index |
((c := self at:index) isLetterOrDigit
or:[c == $:
and:[index == sz
or:[(self at:(index+1)) isLetterOrDigit]]]
) ifFalse:[
^ '#''' , self , ''''
].
].
^ '#' , self
]
].
^ '#''' , self , ''''
"
#abc
#abc:
#abc:def:
#'abc::def'
#'abc &^*'
#'abcdef::'
"
"Modified: / 13.2.1998 / 22:06:15 / stefan"
! !
!Symbol methodsFor:'queries'!
isKeyword
"return true, if the receiver is a keyword message selector"
^ self includes:$:
"
#at:put: isKeyword
#at: isKeyword
#+ isKeyword
#size isKeyword
"
"Created: / 1.11.1997 / 12:34:55 / cg"
"Modified: / 1.11.1997 / 12:36:37 / cg"
!
isSymbol
"return true, if the receiver is some kind of symbol.
Since I am a symbol, return always true"
^ true
!
keywords
"assuming the receiver is a keyword message selector,
return the individual keywords (i.e. break it up at colons)
and return these as a collection.
For binary and unary selectors, the result may be nonsense."
|coll s part|
coll := OrderedCollection new.
s := ReadStream on:self.
[s atEnd] whileFalse:[
part := s through:$:.
coll add:part
].
^ coll asArray
"
#at:put: keywords
#at: keywords
#+ keywords
#size keywords
"
!
species
"when copying, or concatenating, return instances of this class"
^ String
! !
!Symbol methodsFor:'system primitives'!
become:anotherObject
"make all references to the receiver become references to anotherObject
and vice-versa. For symbols, some special action is required, to
correctly handle a become of the global dictionaries.
Anyway: this is very dangerous - mysterous side-effects are to be
expected.
Notice: because of the danger here, this method may report an error
in future versions"
(Smalltalk includesKey:self) ifTrue:[
super become:anotherObject.
%{
__rehashSystemDictionaries();
%}.
] ifFalse:[
super become:anotherObject
]
!
becomeNil
"make all references to the receiver become nil - effectively getting
rid of the receiver. For symbols, this is not allowed, if the receiver
is used as a key in some SytemDictionary.
This can be a very dangerous operation - be warned.
Notice: because of the danger here, this method may report an error
in future versions"
(Smalltalk includesKey:self) ifTrue:[
self primitiveFailed
] ifFalse:[
super becomeNil
]
! !
!Symbol class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.52 1999-02-15 08:48:25 stefan Exp $'
! !