Symbol.st
author claus
Mon, 10 Oct 1994 01:29:28 +0100
changeset 159 514c749165c3
parent 95 d22739a0c6e9
child 189 d430ee92430c
permissions -rw-r--r--
*** empty log message ***

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

String subclass:#Symbol
       instanceVariableNames:''
       classVariableNames:''
       poolDictionaries:''
       category:'Collections-Text'
!

Symbol comment:'
COPYRIGHT (c) 1988 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.12 1994-10-10 00:28:50 claus Exp $
'!

!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.
"
!

version
"
$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.12 1994-10-10 00:28:50 claus Exp $
"
!

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.
"
! !

!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
!

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
!

intern:aString
    "return a unique symbol with printname taken from the String-argument"

%{  /* NOCONTEXT */
    if (__isSymbol(aString)) {
	RETURN (aString);
    }
    if (__isString(aString)) {
	RETURN ( _MKSYMBOL(_stringVal(aString), (OBJ *)0, __context) );
    }
%}
.
    ^ self mustBeString
!

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)."

    |newSym len|

    aString knownAsSymbol ifTrue:[
	^ aString asSymbol
    ].

    "
     create a new uninterned instance first
    "
    len := aString size.
    newSym := super basicNew:len.
    newSym replaceFrom:1 to:len with:aString.

    "now, intern it"
%{
    extern OBJ _INTERNSYMBOL();

    newSym = _INTERNSYMBOL(newSym, (OBJ *)0, __context);
%}.
    ^ newSym
!

internCharacter:aCharacter
    "return a unique symbol with printname taken from the Character-argument"

    ^ self intern:(aCharacter asString)
! !

!Symbol class methodsFor:'queries'!

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"

    aString knownAsSymbol ifTrue:[
	trueBlock value:(aString asSymbol).
	^ true
    ].
    ^ false
!

hasInterned:aString
    "return true, if the argument, aString is known as Symbol;
     false otherwise"

    ^ aString knownAsSymbol
! !

!Symbol methodsFor:'accessing'!

basicAt:index put:something
    "report an error if interned - interned symbols may not be changed."

    self knownAsSymbol ifTrue:[
	self error:'symbols may not be changed'.
	^ something
    ].
    "
     uninterned - allow change
    "
    ^ super basicAt:index put:something
! !

!Symbol methodsFor:'copying'!

copy
    "return a copy of myself
     - reimplemented here since symbols are unique"

     ^ self
!

shallowCopy
    "return a copy of myself
     - reimplemented here since symbols are unique"

     ^ self
!

deepCopy
    "return a copy of myself
     - reimplemented here since symbols are unique"

     ^ self
!

deepCopyUsing:aDictionary
    "return a copy of myself
     - reimplemented here since symbols are unique"

     ^ self
!

simpleDeepCopy
    "return a copy of myself
     - reimplemented here since symbols are unique"

     ^ self
! !

!Symbol methodsFor:'converting'!

asString
    "return a string with printname taken from mine"

    ^ self printString
!

asSymbol
    "I am a symbol - just return myself"

    ^ self
! !

!Symbol methodsFor:'misc'!

species
    ^ 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:'binary storage'!

binaryDefinitionFrom: stream manager: manager
    ^ self intern: (super binaryDefinitionFrom: stream manager: manager)
! !

!Symbol methodsFor:'printing & storing'!

printString
%{
    RETURN ( _MKSTRING(_stringVal(self) COMMA_CON) );
%}
!

printOn:aStream
    "aStream nextPut:$#."
    aStream nextPutAll:self "(self printString)"
!
 
displayString
    "return a string for displaying the receiver"

    ^ self storeString
!

storeString
    "return a String for storing the receiver"

    (self at:1) isLetter ifTrue:[
	2 to:self size do:[:index |
	    (self at:index) isLetterOrDigit ifFalse:[
		^ '#''' , self , ''''
	    ].
	].
	^ '#' , self
    ].
    ^ '#''' , self , ''''
!

storeOn:aStream
    "store myself on a stream"

    aStream nextPutAll:(self storeString)
! !