Symbol.st
changeset 77 6c38ca59927f
parent 68 59faa75185ba
child 88 81dacba7a63a
--- a/Symbol.st	Thu May 12 04:07:15 1994 +0200
+++ b/Symbol.st	Tue May 17 12:09:46 1994 +0200
@@ -22,20 +22,20 @@
 COPYRIGHT (c) 1988 by Claus Gittinger
               All Rights Reserved
 
-Symbols represent unique strings - every symbol with same printString
-exists exactly once in the system; Symbols are used for selectors, global
-variable-keys etc.
-
-$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.8 1994-03-30 09:37:04 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Symbol.st,v 1.9 1994-05-17 10:09:25 claus Exp $
 '!
 
-!Symbol class methodsFor:'instance creation'!
+!Symbol class methodsFor:'documentation'!
 
-XXXbasicNew:size
-    "catch instance creation - symbols are not created with new"
+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.
+"
+! !
 
-    self error:'symbols may not be created with new:'
-! 
+!Symbol class methodsFor:'instance creation'!
 
 basicNew:size
     "redefined to return a string instead of a symbol -
@@ -70,6 +70,36 @@
     ^ 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"
 
@@ -88,20 +118,28 @@
         ^ 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 - symbols may not be changed"
-
-    self error:'symbols may not be changed'
-!
+    "report an error if interned - interned symbols may not be changed."
 
-at:index put:something
-    "report an error - symbols may not be changed"
-
-    self error:'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'!
@@ -147,6 +185,47 @@
     ^ String
 ! !
 
+!Symbol methodsFor:'system primitives'!
+
+become:anotherObject
+    "make all references to the receiver become references to anotherObject
+     and vice-versa. For symbols, some spacial action is required, to
+     correctly handling a become of the global dictionaries.
+     Anyway: this is very dangerous - mysterous side-effects are to be
+     expected."
+
+    (Smalltalk includesKey:self) ifTrue:[
+        super become:anotherObject.
+%{
+        __rehashSystemDictionaries();
+%}.
+    ] ifFalse:[
+        super become:anotherObject
+    ]
+    "
+     |aSym|
+     aSym := #fooBar.
+     Smalltalk at:#fooBar put:1.
+     #fooBar become:#barBaz.
+     'sym is now: ' print. aSym printNL.
+     Smalltalk includesKey:#fooBar
+     Smalltalk at:#barBaz
+    "
+!
+
+becomeNil
+    "make all references to the receiver become nil - effectively getting
+     rid of the receiver. For symbols, this is not allowed, if thr receiver
+     is used as a key in some SytemDictionary.
+     This can be a very dangerous operation - be warned."
+
+    (Smalltalk includesKey:self) ifTrue:[
+        self primitiveFailed
+    ] ifFalse:[
+        super becomeNil
+    ]
+! !
+
 !Symbol class methodsFor:'binary storage'!
 
 binaryDefinitionFrom: stream manager: manager