smalltalk/Behaviour.st

   1 "
   2 Copyright (c) 2007 Luca Bruno
   3
   4 This file is part of Smalltalk YX.
   5
   6 Permission is hereby granted, free of charge, to any person obtaining a copy
   7 of this software and associated documentation files (the 'Software'), to deal
   8 in the Software without restriction, including without limitation the rights
   9 to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  10 copies of the Software, and to permit persons to whom the Software is
  11 furnished to do so, subject to the following conditions:
  12
  13 The above copyright notice and this permission notice shall be included in
  14 all copies or substantial portions of the Software.
  15
  16 THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  17 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  18 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  19 AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  20 LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  21 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  22 DEALINGS IN THE SOFTWARE.
  23 "
  24
  25
  26 name
  27     "Answer my name"
  28     ^name
  29 !
  30
  31 subclasses
  32     "A list of direct subclasses of the receiver"
  33     ^subclasses
  34 !
  35
  36 superclass
  37     "Answer my superclass"
  38     ^superclass
  39 !
  40
  41 methodDictionary
  42     "Returns the Dictionary containing the methods of the class"
  43     ^methodDictionary
  44 !
  45
  46 instanceVariableNames
  47     "Answer a copy of the names of the instance variables"
  48     ^instanceVariableNames copy
  49 !
  50
  51 printString
  52     "My string representation is my name itself"
  53     ^self name asString
  54 !
  55
  56
  57
  58 basicNew
  59     <primitive: 'Behavior_new'>
  60         ^self primitiveFailed
  61 !
  62
  63 new
  64     <primitive: 'Behavior_new'>
  65         ^self primitiveFailed
  66 !
  67
  68 basicNew: anInteger
  69     <primitive: 'Behavior_newColon'>
  70         ^self primitiveFailed
  71 !
  72
  73 new: anInteger
  74     self shouldNotImplement
  75 !
  76
  77 subclass: classSymbol
  78     ^self subclass: classSymbol instanceVariableNames: '' classVariableNames: ''
  79 !
  80
  81 subclass: classSymbol instanceVariableNames: instanceVariables
  82     ^self subclass: classSymbol instanceVariableNames: instanceVariables classVariableNames: ''
  83 !
  84
  85 subclass: classSymbol instanceVariableNames: instanceVariableNames classVariableNames: classVariableNames
  86     | metaclass class |
  87     classSymbol first isUppercase
  88         ifFalse: [ self error: 'Class names must be capitalized' ].
  89
  90     class := Smalltalk at: classSymbol ifAbsent: [
  91         metaclass := Metaclass new.
  92         class := metaclass initializeSubclassOf: self class named: nil.
  93         Smalltalk at: classSymbol put: class ].
  94
  95     ^class
  96         initializeSubclassOf: self named: classSymbol;
  97         setInstanceVariableNames: instanceVariableNames;
  98         setClassVariableNames: classVariableNames;
  99         yourself
 100 !
 101
 102 compile: aString
 103     | method |
 104     method := aString compileFor: self.
 105     methodDictionary
 106         ifNil: [ methodDictionary := Dictionary new: 10 ].
 107     methodDictionary at: method selector put: method
 108 !
 109
 110 updateInstanceSize
 111     instanceSize := superclass instanceSize + instanceVariableNames size.
 112     self allSubclassesDo: [ :ea | ea updateInstanceSize ]
 113 !
 114
 115 parseVariableNames: aString
 116     | lexer token coll |
 117     aString isString
 118         ifFalse: [ self error: 'Expected a string containing variable names' ].
 119     lexer := CompilerLexer text: aString.
 120     coll := OrderedCollection new.
 121     [ (token := lexer nextToken) notNil ]
 122         whileTrue: [
 123             token class = CompilerIdentifierToken
 124                 ifFalse: [ self error: 'Instance variables must be valid identifiers' ].
 125             token first isLowercase
 126                 ifFalse: [ self error: 'Instance variables must not be capitalized' ].
 127             coll add: token asSymbol ].
 128     ^coll asArray
 129 !
 130
 131 setInstanceVariableNames: aString
 132     instanceVariableNames := self parseVariableNames: aString.
 133     self updateInstanceSize
 134 !
 135
 136
 137 instanceSize
 138     ^instanceSize
 139 !
 140
 141 initializeSubclassOf: aClass named: classSymbol
 142     instanceSize := aClass instanceSize.
 143     superclass := aClass.
 144     instanceVariableNames := #().
 145     subclasses := #().
 146     methodDictionary := IdentityDictionary new.
 147     name := classSymbol.
 148     aClass addSubclass: self
 149 !
 150
 151 doesUnderstand: selector
 152     "Answer true if the receiver understand the given message selector, else false"
 153     | class |
 154     class := self.
 155     [ class notNil ]
 156         whileTrue: [
 157             (class methodDictionary includesKey: selector)
 158                 ifTrue: [ ^true ].
 159             class := class superclass ].
 160     ^false
 161 !
 162
 163 addSubclass: aClass
 164     subclasses := subclasses copyWith: aClass
 165 !
 166
 167 allSubclasses
 168     "Answer a list of all subclasses of the receiver"
 169     | ret |
 170     ret := OrderedCollection new.
 171     self allSubclassesDo: [ :ea |
 172         ret add: ea ].
 173     ^ret
 174 !
 175
 176 allSubclassesDo: aBlock
 177     "Call aBlock recursing trough each subclass of this class"
 178     self subclasses do: [ :ea |
 179         aBlock value: ea.
 180         ea allSubclassesDo: aBlock ]
 181 !
 182
 183 allSuperclassesDo: aBlock
 184     "Call aBlock for each superclass of this class"
 185     | class |
 186     class := self.
 187     [ (class := class superclass) notNil ]
 188         whileTrue: [ aBlock value: class ]
 189 !
 190
 191
 192
 193 classVariables
 194     ^classVariables
 195 !
 196
 197 setClassVariableNames: aString
 198     | array |
 199     array := self parseVariableNames: aString.
 200     classVariables := IdentityDictionary new: array size.
 201     array do: [ :ea |
 202         classVariables at: ea put: nil ]
 203 !
 204