Kernel-Classes.st 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725
  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. allSuperclasses
  27. self superclass ifNil: [ ^ #() ].
  28. ^ (OrderedCollection with: self superclass)
  29. addAll: self superclass allSuperclasses;
  30. yourself
  31. !
  32. comment
  33. ^(self basicAt: 'comment') ifNil: ['']
  34. !
  35. comment: aString
  36. self basicAt: 'comment' put: aString.
  37. SystemAnnouncer current
  38. announce: (ClassCommentChanged new
  39. theClass: self;
  40. yourself)
  41. !
  42. commentStamp
  43. ^ClassCommentReader new
  44. class: self;
  45. yourself
  46. !
  47. commentStamp: aStamp prior: prior
  48. ^self commentStamp
  49. !
  50. definition
  51. ^ ''
  52. !
  53. instanceVariableNames
  54. <return self.iVarNames>
  55. !
  56. lookupSelector: selector
  57. "Look up the given selector in my methodDictionary.
  58. Return the corresponding method if found.
  59. Otherwise chase the superclass chain and try again.
  60. Return nil if no method is found."
  61. | lookupClass |
  62. lookupClass := self.
  63. [ lookupClass = nil ] whileFalse: [
  64. (lookupClass includesSelector: selector)
  65. ifTrue: [ ^ lookupClass methodAt: selector ].
  66. lookupClass := lookupClass superclass ].
  67. ^ nil
  68. !
  69. methodAt: aSymbol
  70. ^ self methodDictionary at: aSymbol asString
  71. !
  72. methodDictionary
  73. <var dict = smalltalk.HashedCollection._new();
  74. var methods = self.methods;
  75. for(var i in methods) {
  76. if(methods[i].selector) {
  77. dict._at_put_(methods[i].selector, methods[i]);
  78. }
  79. };
  80. return dict>
  81. !
  82. methods
  83. ^ self methodDictionary values
  84. !
  85. methodsFor: aString
  86. ^ClassCategoryReader new
  87. class: self category: aString;
  88. yourself
  89. !
  90. methodsFor: aString stamp: aStamp
  91. "Added for compatibility, right now ignores stamp."
  92. ^self methodsFor: aString
  93. !
  94. methodsInProtocol: aString
  95. ^ self methodDictionary values select: [ :each | each protocol = aString ]
  96. !
  97. name
  98. <return self.className || nil>
  99. !
  100. organization
  101. ^ self basicAt: 'organization'
  102. !
  103. protocols
  104. ^ self organization elements sorted
  105. !
  106. protocolsDo: aBlock
  107. "Execute aBlock for each method category with
  108. its collection of methods in the sort order of category name."
  109. | methodsByCategory |
  110. methodsByCategory := HashedCollection new.
  111. self methodDictionary values do: [:m |
  112. (methodsByCategory at: m category ifAbsentPut: [Array new])
  113. add: m].
  114. self protocols do: [:category |
  115. aBlock value: category value: (methodsByCategory at: category)]
  116. !
  117. prototype
  118. <return self.fn.prototype>
  119. !
  120. selectors
  121. ^ self methodDictionary keys
  122. !
  123. subclasses
  124. <return smalltalk.subclasses(self)>
  125. !
  126. superclass
  127. <return self.superclass || nil>
  128. !
  129. theMetaClass
  130. ^ self class
  131. !
  132. theNonMetaClass
  133. ^ self
  134. !
  135. withAllSubclasses
  136. ^(Array with: self) addAll: self allSubclasses; yourself
  137. ! !
  138. !Behavior methodsFor: 'compiling'!
  139. addCompiledMethod: aMethod
  140. self basicAddCompiledMethod: aMethod.
  141. SystemAnnouncer current
  142. announce: (MethodAdded new
  143. theClass: self;
  144. method: aMethod;
  145. yourself)
  146. !
  147. compile: aString
  148. self compile: aString category: ''
  149. !
  150. compile: aString category: anotherString
  151. Compiler new
  152. install: aString
  153. forClass: self
  154. category: anotherString
  155. !
  156. removeCompiledMethod: aMethod
  157. self basicRemoveCompiledMethod: aMethod.
  158. SystemAnnouncer current
  159. announce: (MethodRemoved new
  160. theClass: self;
  161. method: aMethod;
  162. yourself)
  163. ! !
  164. !Behavior methodsFor: 'instance creation'!
  165. basicNew
  166. <return new self.fn()>
  167. !
  168. new
  169. ^self basicNew initialize
  170. ! !
  171. !Behavior methodsFor: 'private'!
  172. basicAddCompiledMethod: aMethod
  173. <smalltalk.addMethod(aMethod.selector._asSelector(), aMethod, self)>
  174. !
  175. basicRemoveCompiledMethod: aMethod
  176. <
  177. smalltalk.removeMethod(aMethod)
  178. smalltalk.init(self);
  179. >
  180. ! !
  181. !Behavior methodsFor: 'testing'!
  182. canUnderstand: aSelector
  183. ^(self methodDictionary keys includes: aSelector asString) or: [
  184. self superclass notNil and: [self superclass canUnderstand: aSelector]]
  185. !
  186. includesSelector: aSymbol
  187. ^ self methodDictionary includesKey: aSymbol asString
  188. !
  189. inheritsFrom: aClass
  190. ^aClass allSubclasses includes: self
  191. ! !
  192. Behavior subclass: #Class
  193. instanceVariableNames: ''
  194. package: 'Kernel-Classes'!
  195. !Class commentStamp!
  196. Class is __the__ class object.
  197. Instances are the classes of the system.
  198. Class creation is done throught a `ClassBuilder`!
  199. !Class methodsFor: 'accessing'!
  200. category
  201. ^self package ifNil: ['Unclassified'] ifNotNil: [self package name]
  202. !
  203. definition
  204. ^ String streamContents: [ :stream |
  205. stream
  206. nextPutAll: self superclass asString;
  207. nextPutAll: ' subclass: #';
  208. nextPutAll: self name;
  209. nextPutAll: String lf, String tab;
  210. nextPutAll: 'instanceVariableNames: '''.
  211. self instanceVariableNames
  212. do: [ :each | stream nextPutAll: each ]
  213. separatedBy: [ stream nextPutAll: ' ' ].
  214. stream
  215. nextPutAll: '''', String lf, String tab;
  216. nextPutAll: 'package: ''';
  217. nextPutAll: self category;
  218. nextPutAll: '''' ]
  219. !
  220. package
  221. <return self.pkg>
  222. !
  223. package: aPackage
  224. <self.pkg = aPackage>
  225. !
  226. rename: aString
  227. ClassBuilder new renameClass: self to: aString
  228. ! !
  229. !Class methodsFor: 'class creation'!
  230. subclass: aString instanceVariableNames: anotherString
  231. "Kept for compatibility."
  232. ^self subclass: aString instanceVariableNames: anotherString package: nil
  233. !
  234. subclass: aString instanceVariableNames: aString2 category: aString3
  235. "Kept for compatibility."
  236. self deprecatedAPI.
  237. ^self subclass: aString instanceVariableNames: aString2 package: aString3
  238. !
  239. subclass: aString instanceVariableNames: aString2 classVariableNames: classVars poolDictionaries: pools category: aString3
  240. "Just ignore class variables and pools. Added for compatibility."
  241. ^self subclass: aString instanceVariableNames: aString2 package: aString3
  242. !
  243. subclass: aString instanceVariableNames: aString2 package: aString3
  244. ^ClassBuilder new
  245. superclass: self subclass: aString asString instanceVariableNames: aString2 package: aString3
  246. ! !
  247. !Class methodsFor: 'converting'!
  248. asJavascript
  249. ^ 'smalltalk.', self name
  250. ! !
  251. !Class methodsFor: 'printing'!
  252. printString
  253. ^self name
  254. ! !
  255. !Class methodsFor: 'testing'!
  256. isClass
  257. ^true
  258. ! !
  259. Behavior subclass: #Metaclass
  260. instanceVariableNames: ''
  261. package: 'Kernel-Classes'!
  262. !Metaclass commentStamp!
  263. Metaclass is the root of the class hierarchy.
  264. Metaclass instances are metaclasses, one for each real class.
  265. Metaclass instances have a single instance, which they hold onto, which is the class that they are the metaclass of.!
  266. !Metaclass methodsFor: 'accessing'!
  267. definition
  268. ^ String streamContents: [ :stream |
  269. stream
  270. nextPutAll: self asString;
  271. nextPutAll: ' class ';
  272. nextPutAll: 'instanceVariableNames: '''.
  273. self instanceVariableNames
  274. do: [ :each | stream nextPutAll: each ]
  275. separatedBy: [ stream nextPutAll: ' ' ].
  276. stream nextPutAll: '''' ]
  277. !
  278. instanceClass
  279. <return self.instanceClass>
  280. !
  281. instanceVariableNames: aCollection
  282. ClassBuilder new
  283. class: self instanceVariableNames: aCollection
  284. !
  285. theMetaClass
  286. ^ self
  287. !
  288. theNonMetaClass
  289. ^ self instanceClass
  290. ! !
  291. !Metaclass methodsFor: 'converting'!
  292. asJavascript
  293. ^ 'smalltalk.', self instanceClass name, '.klass'
  294. ! !
  295. !Metaclass methodsFor: 'printing'!
  296. printString
  297. ^self instanceClass name, ' class'
  298. ! !
  299. !Metaclass methodsFor: 'testing'!
  300. isMetaclass
  301. ^true
  302. ! !
  303. Object subclass: #ClassBuilder
  304. instanceVariableNames: ''
  305. package: 'Kernel-Classes'!
  306. !ClassBuilder commentStamp!
  307. ClassBuilder is responsible for compiling new classes or modifying existing classes in the system.
  308. Rather than using ClassBuilder directly to compile a class, use `Class >> subclass:instanceVariableNames:package:`.!
  309. !ClassBuilder methodsFor: 'accessing'!
  310. instanceVariableNamesFor: aString
  311. ^(aString tokenize: ' ') reject: [ :each | each isEmpty ]
  312. ! !
  313. !ClassBuilder methodsFor: 'class definition'!
  314. addSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
  315. | theClass |
  316. theClass := Smalltalk current at: aString.
  317. theClass ifNotNil: [
  318. theClass superclass == aClass ifFalse: [
  319. ^ self
  320. migrateClassNamed: aString
  321. superclass: aClass
  322. instanceVariableNames: aCollection
  323. package: packageName ] ].
  324. ^ self
  325. basicAddSubclassOf: aClass
  326. named: aString
  327. instanceVariableNames: aCollection
  328. package: packageName
  329. !
  330. class: aClass instanceVariableNames: aString
  331. self basicClass: aClass instanceVariableNames: aString.
  332. self setupClass: aClass.
  333. SystemAnnouncer current
  334. announce: (ClassDefinitionChanged new
  335. theClass: aClass;
  336. yourself)
  337. !
  338. superclass: aClass subclass: aString
  339. ^self superclass: aClass subclass: aString instanceVariableNames: '' package: nil
  340. !
  341. superclass: aClass subclass: aString instanceVariableNames: aString2 package: aString3
  342. | newClass |
  343. newClass := self addSubclassOf: aClass
  344. named: aString instanceVariableNames: (self instanceVariableNamesFor: aString2)
  345. package: (aString3 ifNil: ['unclassified']).
  346. self setupClass: newClass.
  347. SystemAnnouncer current
  348. announce: (ClassAdded new
  349. theClass: newClass;
  350. yourself).
  351. ^newClass
  352. ! !
  353. !ClassBuilder methodsFor: 'class migration'!
  354. migrateClass: aClass superclass: anotherClass
  355. console log: aClass name.
  356. self
  357. migrateClassNamed: aClass name
  358. superclass: anotherClass
  359. instanceVariableNames: aClass instanceVariableNames
  360. package: aClass package name
  361. !
  362. migrateClassNamed: aString superclass: aClass instanceVariableNames: aCollection package: packageName
  363. | oldClass newClass tmp |
  364. tmp := 'new*', aString.
  365. oldClass := Smalltalk current at: aString.
  366. newClass := self
  367. addSubclassOf: aClass
  368. named: tmp
  369. instanceVariableNames: aCollection
  370. package: packageName.
  371. self basicSwapClassNames: oldClass with: newClass.
  372. [ self copyClass: oldClass to: newClass ]
  373. on: Error
  374. do: [ :exception |
  375. self
  376. basicSwapClassNames: oldClass with: newClass;
  377. basicRemoveClass: newClass.
  378. exception signal ].
  379. self
  380. rawRenameClass: oldClass to: tmp;
  381. rawRenameClass: newClass to: aString.
  382. oldClass subclasses do: [ :each |
  383. self migrateClass: each superclass: newClass ].
  384. self basicRemoveClass: oldClass.
  385. ^newClass
  386. !
  387. renameClass: aClass to: aString
  388. self basicRenameClass: aClass to: aString.
  389. SystemAnnouncer current
  390. announce: (ClassRenamed new
  391. theClass: aClass;
  392. yourself)
  393. ! !
  394. !ClassBuilder methodsFor: 'copying'!
  395. copyClass: aClass named: aString
  396. | newClass |
  397. newClass := self
  398. addSubclassOf: aClass superclass
  399. named: aString
  400. instanceVariableNames: aClass instanceVariableNames
  401. package: aClass package name.
  402. self copyClass: aClass to: newClass.
  403. ^newClass
  404. !
  405. copyClass: aClass to: anotherClass
  406. anotherClass comment: aClass comment.
  407. aClass methodDictionary values do: [ :each |
  408. Compiler new install: each source forClass: anotherClass category: each category ].
  409. self basicClass: anotherClass class instanceVariables: aClass class instanceVariableNames.
  410. aClass class methodDictionary values do: [ :each |
  411. Compiler new install: each source forClass: anotherClass class category: each category ].
  412. self setupClass: anotherClass
  413. ! !
  414. !ClassBuilder methodsFor: 'method definition'!
  415. installMethod: aCompiledMethod forClass: aBehavior category: aString
  416. aCompiledMethod category: aString.
  417. aBehavior addCompiledMethod: aCompiledMethod.
  418. self setupClass: aBehavior.
  419. ^aCompiledMethod
  420. ! !
  421. !ClassBuilder methodsFor: 'private'!
  422. basicAddSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
  423. <
  424. smalltalk.addClass(aString, aClass, aCollection, packageName);
  425. return smalltalk[aString]
  426. >
  427. !
  428. basicClass: aClass instanceVariableNames: aString
  429. self basicClass: aClass instanceVariables: (self instanceVariableNamesFor: aString)
  430. !
  431. basicClass: aClass instanceVariables: aCollection
  432. aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].
  433. aClass basicAt: 'iVarNames' put: aCollection
  434. !
  435. basicRemoveClass: aClass
  436. <smalltalk.removeClass(aClass)>
  437. !
  438. basicRenameClass: aClass to: aString
  439. <
  440. smalltalk[aString] = aClass;
  441. delete smalltalk[aClass.className];
  442. aClass.className = aString;
  443. >
  444. !
  445. basicSwapClassNames: aClass with: anotherClass
  446. <
  447. var tmp = aClass.className;
  448. aClass.className = anotherClass.className;
  449. anotherClass.className = tmp;
  450. >
  451. !
  452. rawRenameClass: aClass to: aString
  453. <
  454. smalltalk[aString] = aClass;
  455. >
  456. ! !
  457. !ClassBuilder methodsFor: 'public'!
  458. setupClass: aClass
  459. <smalltalk.init(aClass);>
  460. ! !
  461. Object subclass: #ClassCategoryReader
  462. instanceVariableNames: 'class category'
  463. package: 'Kernel-Classes'!
  464. !ClassCategoryReader commentStamp!
  465. ClassCategoryReader represents a mechanism for retrieving class descriptions stored on a file.!
  466. !ClassCategoryReader methodsFor: 'accessing'!
  467. class: aClass category: aString
  468. class := aClass.
  469. category := aString
  470. ! !
  471. !ClassCategoryReader methodsFor: 'fileIn'!
  472. scanFrom: aChunkParser
  473. | chunk |
  474. [chunk := aChunkParser nextChunk.
  475. chunk isEmpty] whileFalse: [
  476. self compileMethod: chunk].
  477. ClassBuilder new setupClass: class
  478. ! !
  479. !ClassCategoryReader methodsFor: 'initialization'!
  480. initialize
  481. super initialize.
  482. ! !
  483. !ClassCategoryReader methodsFor: 'private'!
  484. compileMethod: aString
  485. Compiler new install: aString forClass: class category: category
  486. ! !
  487. Object subclass: #ClassCommentReader
  488. instanceVariableNames: 'class'
  489. package: 'Kernel-Classes'!
  490. !ClassCommentReader commentStamp!
  491. ClassCommentReader represents a mechanism for retrieving class comments stored on a file.
  492. See `ClassCategoryReader` too.!
  493. !ClassCommentReader methodsFor: 'accessing'!
  494. class: aClass
  495. class := aClass
  496. ! !
  497. !ClassCommentReader methodsFor: 'fileIn'!
  498. scanFrom: aChunkParser
  499. | chunk |
  500. chunk := aChunkParser nextChunk.
  501. chunk isEmpty ifFalse: [
  502. self setComment: chunk].
  503. ! !
  504. !ClassCommentReader methodsFor: 'initialization'!
  505. initialize
  506. super initialize.
  507. ! !
  508. !ClassCommentReader methodsFor: 'private'!
  509. setComment: aString
  510. class comment: aString
  511. ! !
  512. Object subclass: #ClassSorterNode
  513. instanceVariableNames: 'theClass level nodes'
  514. package: 'Kernel-Classes'!
  515. !ClassSorterNode methodsFor: 'accessing'!
  516. getNodesFrom: aCollection
  517. | children others |
  518. children := #().
  519. others := #().
  520. aCollection do: [:each |
  521. (each superclass = self theClass)
  522. ifTrue: [children add: each]
  523. ifFalse: [others add: each]].
  524. nodes:= children collect: [:each |
  525. ClassSorterNode on: each classes: others level: self level + 1]
  526. !
  527. level
  528. ^level
  529. !
  530. level: anInteger
  531. level := anInteger
  532. !
  533. nodes
  534. ^nodes
  535. !
  536. theClass
  537. ^theClass
  538. !
  539. theClass: aClass
  540. theClass := aClass
  541. ! !
  542. !ClassSorterNode methodsFor: 'visiting'!
  543. traverseClassesWith: aCollection
  544. "sort classes alphabetically Issue #143"
  545. aCollection add: self theClass.
  546. (self nodes sorted: [:a :b | a theClass name <= b theClass name ]) do: [:aNode |
  547. aNode traverseClassesWith: aCollection ].
  548. ! !
  549. !ClassSorterNode class methodsFor: 'instance creation'!
  550. on: aClass classes: aCollection level: anInteger
  551. ^self new
  552. theClass: aClass;
  553. level: anInteger;
  554. getNodesFrom: aCollection;
  555. yourself
  556. ! !