1
0

Kernel-Classes.st 9.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404
  1. Smalltalk current createPackage: 'Kernel-Classes' properties: #{}!
  2. Object subclass: #Behavior
  3. instanceVariableNames: ''
  4. package: 'Kernel-Classes'!
  5. !Behavior commentStamp!
  6. Behavior is the superclass of all class objects.
  7. It defines the protocol for creating instances of a class with `#basicNew` and `#new` (see `boot.js` for class constructors details).
  8. Instances know about the subclass/superclass relationships between classes, contain the description that instances are created from,
  9. and hold the method dictionary that's associated with each class.
  10. Behavior also provides methods for compiling methods, examining the method dictionary, and iterating over the class hierarchy.!
  11. !Behavior methodsFor: 'accessing'!
  12. allInstanceVariableNames
  13. | result |
  14. result := self instanceVariableNames copy.
  15. self superclass ifNotNil: [
  16. result addAll: self superclass allInstanceVariableNames].
  17. ^result
  18. !
  19. allSubclasses
  20. | result |
  21. result := self subclasses.
  22. self subclasses do: [:each |
  23. result addAll: each allSubclasses].
  24. ^result
  25. !
  26. comment
  27. ^(self basicAt: 'comment') ifNil: ['']
  28. !
  29. comment: aString
  30. self basicAt: 'comment' put: aString
  31. !
  32. commentStamp
  33. ^ClassCommentReader new
  34. class: self;
  35. yourself
  36. !
  37. commentStamp: aStamp prior: prior
  38. ^self commentStamp
  39. !
  40. instanceVariableNames
  41. <return self.iVarNames>
  42. !
  43. methodAt: aString
  44. <return smalltalk.methods(self)[aString]>
  45. !
  46. methodDictionary
  47. <var dict = smalltalk.HashedCollection._new();
  48. var methods = self.fn.prototype.methods;
  49. for(var i in methods) {
  50. if(methods[i].selector) {
  51. dict._at_put_(methods[i].selector, methods[i]);
  52. }
  53. };
  54. return dict>
  55. !
  56. methodsFor: aString
  57. ^ClassCategoryReader new
  58. class: self category: aString;
  59. yourself
  60. !
  61. methodsFor: aString stamp: aStamp
  62. "Added for compatibility, right now ignores stamp."
  63. ^self methodsFor: aString
  64. !
  65. name
  66. <return self.className || nil>
  67. !
  68. protocols
  69. | protocols |
  70. protocols := Array new.
  71. self methodDictionary do: [:each |
  72. (protocols includes: each category) ifFalse: [
  73. protocols add: each category]].
  74. ^protocols sort
  75. !
  76. protocolsDo: aBlock
  77. "Execute aBlock for each method category with
  78. its collection of methods in the sort order of category name."
  79. | methodsByCategory |
  80. methodsByCategory := HashedCollection new.
  81. self methodDictionary values do: [:m |
  82. (methodsByCategory at: m category ifAbsentPut: [Array new])
  83. add: m].
  84. self protocols do: [:category |
  85. aBlock value: category value: (methodsByCategory at: category)]
  86. !
  87. prototype
  88. <return self.fn.prototype>
  89. !
  90. subclasses
  91. <return smalltalk.subclasses(self)>
  92. !
  93. superclass
  94. <return self.superclass || nil>
  95. !
  96. withAllSubclasses
  97. ^(Array with: self) addAll: self allSubclasses; yourself
  98. ! !
  99. !Behavior methodsFor: 'compiling'!
  100. addCompiledMethod: aMethod
  101. <smalltalk.addMethod(aMethod.selector._asSelector(), aMethod, self)>
  102. !
  103. compile: aString
  104. self compile: aString category: ''
  105. !
  106. compile: aString category: anotherString
  107. | method |
  108. method := Compiler new load: aString forClass: self.
  109. method category: anotherString.
  110. self addCompiledMethod: method
  111. !
  112. removeCompiledMethod: aMethod
  113. <delete self.fn.prototype[aMethod.selector._asSelector()];
  114. delete self.fn.prototype.methods[aMethod.selector];
  115. smalltalk.init(self);>
  116. ! !
  117. !Behavior methodsFor: 'instance creation'!
  118. basicNew
  119. <return new self.fn()>
  120. !
  121. new
  122. ^self basicNew initialize
  123. ! !
  124. !Behavior methodsFor: 'testing'!
  125. inheritsFrom: aClass
  126. ^aClass allSubclasses includes: self
  127. ! !
  128. Behavior subclass: #Class
  129. instanceVariableNames: ''
  130. package: 'Kernel-Classes'!
  131. !Class commentStamp!
  132. Class is __the__ class object.
  133. Instances are the classes of the system.
  134. Class creation is done throught a `ClassBuilder`!
  135. !Class methodsFor: 'accessing'!
  136. category
  137. ^self package ifNil: ['Unclassified'] ifNotNil: [self package name]
  138. !
  139. package
  140. <return self.pkg>
  141. !
  142. package: aPackage
  143. <self.pkg = aPackage>
  144. !
  145. rename: aString
  146. <
  147. smalltalk[aString] = self;
  148. delete smalltalk[self.className];
  149. self.className = aString;
  150. >
  151. ! !
  152. !Class methodsFor: 'class creation'!
  153. subclass: aString instanceVariableNames: anotherString
  154. "Kept for compatibility."
  155. ^self subclass: aString instanceVariableNames: anotherString package: nil
  156. !
  157. subclass: aString instanceVariableNames: aString2 category: aString3
  158. "Kept for compatibility."
  159. self deprecatedAPI.
  160. ^self subclass: aString instanceVariableNames: aString2 package: aString3
  161. !
  162. subclass: aString instanceVariableNames: aString2 classVariableNames: classVars poolDictionaries: pools category: aString3
  163. "Just ignore class variables and pools. Added for compatibility."
  164. ^self subclass: aString instanceVariableNames: aString2 package: aString3
  165. !
  166. subclass: aString instanceVariableNames: aString2 package: aString3
  167. ^ClassBuilder new
  168. superclass: self subclass: aString asString instanceVariableNames: aString2 package: aString3
  169. ! !
  170. !Class methodsFor: 'printing'!
  171. printString
  172. ^self name
  173. ! !
  174. !Class methodsFor: 'testing'!
  175. isClass
  176. ^true
  177. ! !
  178. Behavior subclass: #Metaclass
  179. instanceVariableNames: ''
  180. package: 'Kernel-Classes'!
  181. !Metaclass commentStamp!
  182. Metaclass is the root of the class hierarchy.
  183. Metaclass instances are metaclasses, one for each real class.
  184. Metaclass instances have a single instance, which they hold onto, which is the class that they are the metaclass of.!
  185. !Metaclass methodsFor: 'accessing'!
  186. instanceClass
  187. <return self.instanceClass>
  188. !
  189. instanceVariableNames: aCollection
  190. ClassBuilder new
  191. class: self instanceVariableNames: aCollection
  192. ! !
  193. !Metaclass methodsFor: 'printing'!
  194. printString
  195. ^self instanceClass name, ' class'
  196. ! !
  197. !Metaclass methodsFor: 'testing'!
  198. isMetaclass
  199. ^true
  200. ! !
  201. Object subclass: #ClassBuilder
  202. instanceVariableNames: ''
  203. package: 'Kernel-Classes'!
  204. !ClassBuilder commentStamp!
  205. ClassBuilder is responsible for compiling new classes or modifying existing classes in the system.
  206. Rather than using ClassBuilder directly to compile a class, use `Class >> subclass:instanceVariableNames:package:`.!
  207. !ClassBuilder methodsFor: 'class creation'!
  208. class: aClass instanceVariableNames: aString
  209. aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].
  210. aClass basicAt: 'iVarNames' put: (self instanceVariableNamesFor: aString).
  211. self setupClass: aClass
  212. !
  213. superclass: aClass subclass: aString
  214. ^self superclass: aClass subclass: aString instanceVariableNames: '' package: nil
  215. !
  216. superclass: aClass subclass: aString instanceVariableNames: aString2 package: aString3
  217. | newClass |
  218. newClass := self addSubclassOf: aClass
  219. named: aString instanceVariableNames: (self instanceVariableNamesFor: aString2)
  220. package: (aString3 ifNil: ['unclassified']).
  221. self setupClass: newClass.
  222. ^newClass
  223. ! !
  224. !ClassBuilder methodsFor: 'private'!
  225. addSubclassOf: aClass named: aString instanceVariableNames: aCollection
  226. <smalltalk.addClass(aString, aClass, aCollection);
  227. return smalltalk[aString]>
  228. !
  229. addSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
  230. <smalltalk.addClass(aString, aClass, aCollection, packageName);
  231. return smalltalk[aString]>
  232. !
  233. copyClass: aClass named: aString
  234. | newClass |
  235. newClass := self
  236. addSubclassOf: aClass superclass
  237. named: aString
  238. instanceVariableNames: aClass instanceVariableNames
  239. package: aClass package name.
  240. self setupClass: newClass.
  241. aClass methodDictionary values do: [:each |
  242. newClass addCompiledMethod: (Compiler new load: each source forClass: newClass).
  243. (newClass methodDictionary at: each selector) category: each category].
  244. aClass class methodDictionary values do: [:each |
  245. newClass class addCompiledMethod: (Compiler new load: each source forClass: newClass class).
  246. (newClass class methodDictionary at: each selector) category: each category].
  247. self setupClass: newClass.
  248. ^newClass
  249. !
  250. instanceVariableNamesFor: aString
  251. ^(aString tokenize: ' ') reject: [:each | each isEmpty]
  252. !
  253. setupClass: aClass
  254. <smalltalk.init(aClass);>
  255. ! !
  256. Object subclass: #ClassCategoryReader
  257. instanceVariableNames: 'class category chunkParser'
  258. package: 'Kernel-Classes'!
  259. !ClassCategoryReader commentStamp!
  260. ClassCategoryReader represents a mechanism for retrieving class descriptions stored on a file.!
  261. !ClassCategoryReader methodsFor: 'accessing'!
  262. class: aClass category: aString
  263. class := aClass.
  264. category := aString
  265. ! !
  266. !ClassCategoryReader methodsFor: 'fileIn'!
  267. scanFrom: aChunkParser
  268. | chunk |
  269. [chunk := aChunkParser nextChunk.
  270. chunk isEmpty] whileFalse: [
  271. self compileMethod: chunk]
  272. ! !
  273. !ClassCategoryReader methodsFor: 'initialization'!
  274. initialize
  275. super initialize.
  276. chunkParser := ChunkParser new.
  277. ! !
  278. !ClassCategoryReader methodsFor: 'private'!
  279. compileMethod: aString
  280. | method compiler |
  281. method := (compiler := Compiler new) load: aString forClass: class.
  282. method category: category.
  283. class addCompiledMethod: method.
  284. compiler setupClass: class.
  285. ! !
  286. Object subclass: #ClassCommentReader
  287. instanceVariableNames: 'class chunkParser'
  288. package: 'Kernel-Classes'!
  289. !ClassCommentReader commentStamp!
  290. ClassCommentReader represents a mechanism for retrieving class descriptions stored on a file.
  291. See `ClassCategoryReader` too.!
  292. !ClassCommentReader methodsFor: 'accessing'!
  293. class: aClass
  294. class := aClass
  295. ! !
  296. !ClassCommentReader methodsFor: 'fileIn'!
  297. scanFrom: aChunkParser
  298. | chunk |
  299. chunk := aChunkParser nextChunk.
  300. chunk isEmpty ifFalse: [
  301. self setComment: chunk].
  302. ! !
  303. !ClassCommentReader methodsFor: 'initialization'!
  304. initialize
  305. super initialize.
  306. chunkParser := ChunkParser new.
  307. ! !
  308. !ClassCommentReader methodsFor: 'private'!
  309. setComment: aString
  310. class comment: aString
  311. ! !