2
0

Kernel-Classes.st 9.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403
  1. Smalltalk current createPackage: 'Kernel-Classes' properties: #{}!
  2. Object subclass: #Behavior
  3. instanceVariableNames: ''
  4. category: '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. name
  13. <return self.className || nil>
  14. !
  15. superclass
  16. <return self.superclass || nil>
  17. !
  18. subclasses
  19. <return smalltalk.subclasses(self)>
  20. !
  21. allSubclasses
  22. | result |
  23. result := self subclasses.
  24. self subclasses do: [:each |
  25. result addAll: each allSubclasses].
  26. ^result
  27. !
  28. withAllSubclasses
  29. ^(Array with: self) addAll: self allSubclasses; yourself
  30. !
  31. prototype
  32. <return self.fn.prototype>
  33. !
  34. methodDictionary
  35. <var dict = smalltalk.HashedCollection._new();
  36. var methods = self.fn.prototype.methods;
  37. for(var i in methods) {
  38. if(methods[i].selector) {
  39. dict._at_put_(methods[i].selector, methods[i]);
  40. }
  41. };
  42. return dict>
  43. !
  44. methodsFor: aString
  45. ^ClassCategoryReader new
  46. class: self category: aString;
  47. yourself
  48. !
  49. instanceVariableNames
  50. <return self.iVarNames>
  51. !
  52. comment
  53. ^(self basicAt: 'comment') ifNil: ['']
  54. !
  55. comment: aString
  56. self basicAt: 'comment' put: aString
  57. !
  58. commentStamp
  59. ^ClassCommentReader new
  60. class: self;
  61. yourself
  62. !
  63. protocols
  64. | protocols |
  65. protocols := Array new.
  66. self methodDictionary do: [:each |
  67. (protocols includes: each category) ifFalse: [
  68. protocols add: each category]].
  69. ^protocols sort
  70. !
  71. protocolsDo: aBlock
  72. "Execute aBlock for each method category with
  73. its collection of methods in the sort order of category name."
  74. | methodsByCategory |
  75. methodsByCategory := HashedCollection new.
  76. self methodDictionary values do: [:m |
  77. (methodsByCategory at: m category ifAbsentPut: [Array new])
  78. add: m].
  79. self protocols do: [:category |
  80. aBlock value: category value: (methodsByCategory at: category)]
  81. !
  82. allInstanceVariableNames
  83. | result |
  84. result := self instanceVariableNames copy.
  85. self superclass ifNotNil: [
  86. result addAll: self superclass allInstanceVariableNames].
  87. ^result
  88. !
  89. methodAt: aString
  90. <return smalltalk.methods(self)[aString]>
  91. !
  92. methodsFor: aString stamp: aStamp
  93. "Added for compatibility, right now ignores stamp."
  94. ^self methodsFor: aString
  95. !
  96. commentStamp: aStamp prior: prior
  97. ^self commentStamp
  98. ! !
  99. !Behavior methodsFor: 'compiling'!
  100. addCompiledMethod: aMethod
  101. <smalltalk.addMethod(aMethod.selector._asSelector(), aMethod, self)>
  102. !
  103. removeCompiledMethod: aMethod
  104. <delete self.fn.prototype[aMethod.selector._asSelector()];
  105. delete self.fn.prototype.methods[aMethod.selector];
  106. smalltalk.init(self);>
  107. !
  108. compile: aString
  109. self compile: aString category: ''
  110. !
  111. compile: aString category: anotherString
  112. | method |
  113. method := Compiler new load: aString forClass: self.
  114. method category: anotherString.
  115. self addCompiledMethod: method
  116. ! !
  117. !Behavior methodsFor: 'instance creation'!
  118. new
  119. ^self basicNew initialize
  120. !
  121. basicNew
  122. <return new self.fn()>
  123. ! !
  124. !Behavior methodsFor: 'testing'!
  125. inheritsFrom: aClass
  126. ^aClass allSubclasses includes: self
  127. ! !
  128. Behavior subclass: #Class
  129. instanceVariableNames: ''
  130. category: '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. rename: aString
  140. <
  141. smalltalk[aString] = self;
  142. delete smalltalk[self.className];
  143. self.className = aString;
  144. >
  145. !
  146. package
  147. <return self.pkg>
  148. !
  149. package: aPackage
  150. <self.pkg = aPackage>
  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. category: '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. category: '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. superclass: aClass subclass: aString
  209. ^self superclass: aClass subclass: aString instanceVariableNames: '' package: nil
  210. !
  211. class: aClass instanceVariableNames: aString
  212. aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].
  213. aClass basicAt: 'iVarNames' put: (self instanceVariableNamesFor: aString).
  214. self setupClass: aClass
  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. instanceVariableNamesFor: aString
  226. ^(aString tokenize: ' ') reject: [:each | each isEmpty]
  227. !
  228. addSubclassOf: aClass named: aString instanceVariableNames: aCollection
  229. <smalltalk.addClass(aString, aClass, aCollection);
  230. return smalltalk[aString]>
  231. !
  232. setupClass: aClass
  233. <smalltalk.init(aClass);>
  234. !
  235. addSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
  236. <smalltalk.addClass(aString, aClass, aCollection, packageName);
  237. return smalltalk[aString]>
  238. !
  239. copyClass: aClass named: aString
  240. | newClass |
  241. newClass := self
  242. addSubclassOf: aClass superclass
  243. named: aString
  244. instanceVariableNames: aClass instanceVariableNames
  245. package: aClass package name.
  246. self setupClass: newClass.
  247. aClass methodDictionary values do: [:each |
  248. newClass addCompiledMethod: (Compiler new load: each source forClass: newClass).
  249. (newClass methodDictionary at: each selector) category: each category].
  250. aClass class methodDictionary values do: [:each |
  251. newClass class addCompiledMethod: (Compiler new load: each source forClass: newClass class).
  252. (newClass class methodDictionary at: each selector) category: each category].
  253. self setupClass: newClass.
  254. ^newClass
  255. ! !
  256. Object subclass: #ClassCategoryReader
  257. instanceVariableNames: 'class category chunkParser'
  258. category: '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 |
  281. method := Compiler new load: aString forClass: class.
  282. method category: category.
  283. class addCompiledMethod: method
  284. ! !
  285. Object subclass: #ClassCommentReader
  286. instanceVariableNames: 'class chunkParser'
  287. category: 'Kernel-Classes'!
  288. !ClassCommentReader commentStamp!
  289. ClassCommentReader represents a mechanism for retrieving class descriptions stored on a file.
  290. See `ClassCategoryReader` too.!
  291. !ClassCommentReader methodsFor: 'accessing'!
  292. class: aClass
  293. class := aClass
  294. ! !
  295. !ClassCommentReader methodsFor: 'fileIn'!
  296. scanFrom: aChunkParser
  297. | chunk |
  298. chunk := aChunkParser nextChunk.
  299. chunk isEmpty ifFalse: [
  300. self setComment: chunk].
  301. ! !
  302. !ClassCommentReader methodsFor: 'initialization'!
  303. initialize
  304. super initialize.
  305. chunkParser := ChunkParser new.
  306. ! !
  307. !ClassCommentReader methodsFor: 'private'!
  308. setComment: aString
  309. class comment: aString
  310. ! !