1
0

Compiler.st 34 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397
  1. Object subclass: #ChunkParser
  2. instanceVariableNames: 'stream'
  3. category: 'Compiler'!
  4. !ChunkParser methodsFor: 'accessing'!
  5. stream: aStream
  6. stream := aStream
  7. ! !
  8. !ChunkParser methodsFor: 'reading'!
  9. nextChunk
  10. "The chunk format (Smalltalk Interchange Format or Fileout format)
  11. is a trivial format but can be a bit tricky to understand:
  12. - Uses the exclamation mark as delimiter of chunks.
  13. - Inside a chunk a normal exclamation mark must be doubled.
  14. - A non empty chunk must be a valid Smalltalk expression.
  15. - A chunk on top level with a preceding empty chunk is an instruction chunk:
  16. - The object created by the expression then takes over reading chunks.
  17. This metod returns next chunk as a String (trimmed), empty String (all whitespace) or nil."
  18. | char result chunk |
  19. result := '' writeStream.
  20. [char := stream next.
  21. char notNil] whileTrue: [
  22. char = '!!' ifTrue: [
  23. stream peek = '!!'
  24. ifTrue: [stream next "skipping the escape double"]
  25. ifFalse: [^result contents trimBoth "chunk end marker found"]].
  26. result nextPut: char].
  27. ^nil "a chunk needs to end with !!"
  28. ! !
  29. !ChunkParser class methodsFor: 'not yet classified'!
  30. on: aStream
  31. ^self new stream: aStream
  32. ! !
  33. Object subclass: #Importer
  34. instanceVariableNames: ''
  35. category: 'Compiler'!
  36. !Importer methodsFor: 'fileIn'!
  37. import: aStream
  38. | chunk result parser lastEmpty |
  39. parser := ChunkParser on: aStream.
  40. lastEmpty := false.
  41. [chunk := parser nextChunk.
  42. chunk isNil] whileFalse: [
  43. chunk isEmpty
  44. ifTrue: [lastEmpty := true]
  45. ifFalse: [
  46. result := Compiler new loadExpression: chunk.
  47. lastEmpty
  48. ifTrue: [
  49. lastEmpty := false.
  50. result scanFrom: parser]]]
  51. ! !
  52. Object subclass: #Exporter
  53. instanceVariableNames: ''
  54. category: 'Compiler'!
  55. !Exporter methodsFor: 'fileOut'!
  56. export: aClass
  57. "Export a single class. Subclasses override these methods."
  58. ^String streamContents: [:stream |
  59. self exportDefinitionOf: aClass on: stream.
  60. self exportMethodsOf: aClass on: stream.
  61. self exportMetaDefinitionOf: aClass on: stream.
  62. self exportMethodsOf: aClass class on: stream]
  63. !
  64. exportPackage: packageName
  65. "Export a given package by name."
  66. ^String streamContents: [:stream |
  67. (Smalltalk current packageAt: packageName)
  68. classes do: [:each |
  69. stream nextPutAll: (self export: each)].
  70. self exportPackageExtensions: packageName on: stream]
  71. !
  72. exportAll
  73. "Export all packages in the system."
  74. ^String streamContents: [:stream |
  75. Smalltalk current packages do: [:pkg |
  76. stream nextPutAll: (self exportPackage: pkg name)]]
  77. ! !
  78. !Exporter methodsFor: 'private'!
  79. exportDefinitionOf: aClass on: aStream
  80. aStream
  81. nextPutAll: 'smalltalk.addClass(';
  82. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  83. nextPutAll: 'smalltalk.', (self classNameFor: aClass superclass);
  84. nextPutAll: ', ['.
  85. aClass instanceVariableNames
  86. do: [:each | aStream nextPutAll: '''', each, '''']
  87. separatedBy: [aStream nextPutAll: ', '].
  88. aStream
  89. nextPutAll: '], ''';
  90. nextPutAll: aClass category, '''';
  91. nextPutAll: ');'.
  92. aClass comment notEmpty ifTrue: [
  93. aStream
  94. lf;
  95. nextPutAll: 'smalltalk.';
  96. nextPutAll: (self classNameFor: aClass);
  97. nextPutAll: '.comment=';
  98. nextPutAll: 'unescape(''', aClass comment escaped, ''')'].
  99. aStream lf
  100. !
  101. exportMetaDefinitionOf: aClass on: aStream
  102. aClass class instanceVariableNames isEmpty ifFalse: [
  103. aStream
  104. nextPutAll: 'smalltalk.', (self classNameFor: aClass class);
  105. nextPutAll: '.iVarNames = ['.
  106. aClass class instanceVariableNames
  107. do: [:each | aStream nextPutAll: '''', each, '''']
  108. separatedBy: [aStream nextPutAll: ','].
  109. aStream nextPutAll: '];', String lf]
  110. !
  111. exportMethodsOf: aClass on: aStream
  112. aClass methodDictionary values do: [:each |
  113. (each category match: '^\*') ifFalse: [
  114. self exportMethod: each of: aClass on: aStream]].
  115. aStream lf
  116. !
  117. classNameFor: aClass
  118. ^aClass isMetaclass
  119. ifTrue: [aClass instanceClass name, '.klass']
  120. ifFalse: [
  121. aClass isNil
  122. ifTrue: ['nil']
  123. ifFalse: [aClass name]]
  124. !
  125. exportMethod: aMethod of: aClass on: aStream
  126. aStream
  127. nextPutAll: 'smalltalk.addMethod(';lf;
  128. nextPutAll: 'unescape(''', aMethod selector asSelector escaped, '''),';lf;
  129. nextPutAll: 'smalltalk.method({';lf;
  130. nextPutAll: 'selector: unescape(''', aMethod selector escaped, '''),';lf;
  131. nextPutAll: 'category: ''', aMethod category, ''',';lf;
  132. nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
  133. nextPutAll: 'args: ', aMethod arguments asJavascript, ','; lf;
  134. nextPutAll: 'source: unescape(''', aMethod source escaped, '''),';lf;
  135. nextPutAll: 'messageSends: ', aMethod messageSends asJavascript, ',';lf;
  136. nextPutAll: 'referencedClasses: ['.
  137. aMethod referencedClasses
  138. do: [:each | aStream nextPutAll: 'smalltalk.', (self classNameFor: each)]
  139. separatedBy: [aStream nextPutAll: ','].
  140. aStream
  141. nextPutAll: ']';lf;
  142. nextPutAll: '}),';lf;
  143. nextPutAll: 'smalltalk.', (self classNameFor: aClass);
  144. nextPutAll: ');';lf;lf
  145. !
  146. exportPackageExtensions: packageName on: aStream
  147. Smalltalk current classes, (Smalltalk current classes collect: [:each | each class]) do: [:each |
  148. each methodDictionary values do: [:method |
  149. method category = ('*', packageName) ifTrue: [
  150. self exportMethod: method of: each on: aStream]]]
  151. ! !
  152. Exporter subclass: #ChunkExporter
  153. instanceVariableNames: ''
  154. category: 'Compiler'!
  155. !ChunkExporter methodsFor: 'not yet classified'!
  156. exportDefinitionOf: aClass on: aStream
  157. "Chunk format."
  158. aStream
  159. nextPutAll: (self classNameFor: aClass superclass);
  160. nextPutAll: ' subclass: #', (self classNameFor: aClass); lf;
  161. nextPutAll: ' instanceVariableNames: '''.
  162. aClass instanceVariableNames
  163. do: [:each | aStream nextPutAll: each]
  164. separatedBy: [aStream nextPutAll: ' '].
  165. aStream
  166. nextPutAll: ''''; lf;
  167. nextPutAll: ' category: ''', aClass category, '''!!'; lf.
  168. aClass comment notEmpty ifTrue: [
  169. aStream
  170. nextPutAll: '!!', (self classNameFor: aClass), ' commentStamp!!';lf;
  171. nextPutAll: (self chunkEscape: aClass comment), '!!';lf].
  172. aStream lf
  173. !
  174. exportMethod: aMethod of: aClass on: aStream
  175. aStream
  176. lf; lf; nextPutAll: (self chunkEscape: aMethod source); lf;
  177. nextPutAll: '!!'
  178. !
  179. exportMethodsOf: aClass on: aStream
  180. aClass protocolsDo: [:category :methods |
  181. (category match: '^\*') ifFalse: [
  182. self
  183. exportMethods: methods
  184. category: category
  185. of: aClass
  186. on: aStream]]
  187. !
  188. exportMetaDefinitionOf: aClass on: aStream
  189. aClass class instanceVariableNames isEmpty ifFalse: [
  190. aStream
  191. nextPutAll: (self classNameFor: aClass class);
  192. nextPutAll: ' instanceVariableNames: '''.
  193. aClass class instanceVariableNames
  194. do: [:each | aStream nextPutAll: each]
  195. separatedBy: [aStream nextPutAll: ' '].
  196. aStream
  197. nextPutAll: '''!!'; lf; lf]
  198. !
  199. classNameFor: aClass
  200. ^aClass isMetaclass
  201. ifTrue: [aClass instanceClass name, ' class']
  202. ifFalse: [
  203. aClass isNil
  204. ifTrue: ['nil']
  205. ifFalse: [aClass name]]
  206. !
  207. chunkEscape: aString
  208. "Replace all occurrences of !! with !!!! and trim at both ends."
  209. ^(aString replace: '!!' with: '!!!!') trimBoth
  210. !
  211. exportMethods: methods category: category of: aClass on: aStream
  212. aStream
  213. nextPutAll: '!!', (self classNameFor: aClass);
  214. nextPutAll: ' methodsFor: ''', category, '''!!'.
  215. methods do: [:each |
  216. self exportMethod: each of: aClass on: aStream].
  217. aStream nextPutAll: ' !!'; lf; lf
  218. !
  219. exportPackageExtensions: aString on: aStream
  220. "We need to override this one too since we need to group
  221. all methods in a given protocol under a leading methodsFor: chunk
  222. for that class."
  223. Smalltalk current classes, (Smalltalk current classes collect: [:each | each class]) do: [:each |
  224. each protocolsDo: [:category :methods |
  225. category = ('*', aString) ifTrue: [
  226. self exportMethods: methods category: category of: each on: aStream]]]
  227. ! !
  228. Exporter subclass: #StrippedExporter
  229. instanceVariableNames: ''
  230. category: 'Compiler'!
  231. !StrippedExporter methodsFor: 'private'!
  232. exportDefinitionOf: aClass on: aStream
  233. aStream
  234. nextPutAll: 'smalltalk.addClass(';
  235. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  236. nextPutAll: 'smalltalk.', (self classNameFor: aClass superclass);
  237. nextPutAll: ', ['.
  238. aClass instanceVariableNames
  239. do: [:each | aStream nextPutAll: '''', each, '''']
  240. separatedBy: [aStream nextPutAll: ', '].
  241. aStream
  242. nextPutAll: '], ''';
  243. nextPutAll: aClass category, '''';
  244. nextPutAll: ');'.
  245. aStream lf
  246. !
  247. exportMethod: aMethod of: aClass on: aStream
  248. aStream
  249. nextPutAll: 'smalltalk.addMethod(';lf;
  250. nextPutAll: '''', aMethod selector asSelector, ''',';lf;
  251. nextPutAll: 'smalltalk.method({';lf;
  252. nextPutAll: 'selector: ''', aMethod selector, ''',';lf;
  253. nextPutAll: 'fn: ', aMethod fn compiledSource;lf;
  254. nextPutAll: '}),';lf;
  255. nextPutAll: 'smalltalk.', (self classNameFor: aClass);
  256. nextPutAll: ');';lf;lf
  257. ! !
  258. Object subclass: #Node
  259. instanceVariableNames: 'nodes'
  260. category: 'Compiler'!
  261. !Node methodsFor: 'accessing'!
  262. nodes
  263. ^nodes ifNil: [nodes := Array new]
  264. !
  265. addNode: aNode
  266. self nodes add: aNode
  267. ! !
  268. !Node methodsFor: 'building'!
  269. nodes: aCollection
  270. nodes := aCollection
  271. ! !
  272. !Node methodsFor: 'testing'!
  273. isValueNode
  274. ^false
  275. !
  276. isBlockNode
  277. ^false
  278. !
  279. isBlockSequenceNode
  280. ^false
  281. ! !
  282. !Node methodsFor: 'visiting'!
  283. accept: aVisitor
  284. aVisitor visitNode: self
  285. ! !
  286. Node subclass: #MethodNode
  287. instanceVariableNames: 'selector arguments source'
  288. category: 'Compiler'!
  289. !MethodNode methodsFor: 'accessing'!
  290. selector
  291. ^selector
  292. !
  293. selector: aString
  294. selector := aString
  295. !
  296. arguments
  297. ^arguments ifNil: [#()]
  298. !
  299. arguments: aCollection
  300. arguments := aCollection
  301. !
  302. source
  303. ^source
  304. !
  305. source: aString
  306. source := aString
  307. ! !
  308. !MethodNode methodsFor: 'visiting'!
  309. accept: aVisitor
  310. aVisitor visitMethodNode: self
  311. ! !
  312. Node subclass: #SendNode
  313. instanceVariableNames: 'selector arguments receiver'
  314. category: 'Compiler'!
  315. !SendNode methodsFor: 'accessing'!
  316. selector
  317. ^selector
  318. !
  319. selector: aString
  320. selector := aString
  321. !
  322. arguments
  323. ^arguments ifNil: [arguments := #()]
  324. !
  325. arguments: aCollection
  326. arguments := aCollection
  327. !
  328. receiver
  329. ^receiver
  330. !
  331. receiver: aNode
  332. receiver := aNode
  333. !
  334. valueForReceiver: anObject
  335. ^SendNode new
  336. receiver: (self receiver
  337. ifNil: [anObject]
  338. ifNotNil: [self receiver valueForReceiver: anObject]);
  339. selector: self selector;
  340. arguments: self arguments;
  341. yourself
  342. !
  343. cascadeNodeWithMessages: aCollection
  344. | first |
  345. first := SendNode new
  346. selector: self selector;
  347. arguments: self arguments;
  348. yourself.
  349. ^CascadeNode new
  350. receiver: self receiver;
  351. nodes: (Array with: first), aCollection;
  352. yourself
  353. ! !
  354. !SendNode methodsFor: 'visiting'!
  355. accept: aVisitor
  356. aVisitor visitSendNode: self
  357. ! !
  358. Node subclass: #CascadeNode
  359. instanceVariableNames: 'receiver'
  360. category: 'Compiler'!
  361. !CascadeNode methodsFor: 'accessing'!
  362. receiver
  363. ^receiver
  364. !
  365. receiver: aNode
  366. receiver := aNode
  367. ! !
  368. !CascadeNode methodsFor: 'visiting'!
  369. accept: aVisitor
  370. aVisitor visitCascadeNode: self
  371. ! !
  372. Node subclass: #AssignmentNode
  373. instanceVariableNames: 'left right'
  374. category: 'Compiler'!
  375. !AssignmentNode methodsFor: 'accessing'!
  376. left
  377. ^left
  378. !
  379. left: aNode
  380. left := aNode.
  381. left assigned: true
  382. !
  383. right
  384. ^right
  385. !
  386. right: aNode
  387. right := aNode
  388. ! !
  389. !AssignmentNode methodsFor: 'visiting'!
  390. accept: aVisitor
  391. aVisitor visitAssignmentNode: self
  392. ! !
  393. Node subclass: #BlockNode
  394. instanceVariableNames: 'parameters inlined'
  395. category: 'Compiler'!
  396. !BlockNode methodsFor: 'accessing'!
  397. parameters
  398. ^parameters ifNil: [parameters := Array new]
  399. !
  400. parameters: aCollection
  401. parameters := aCollection
  402. !
  403. inlined
  404. ^inlined ifNil: [false]
  405. !
  406. inlined: aBoolean
  407. inlined := aBoolean
  408. ! !
  409. !BlockNode methodsFor: 'testing'!
  410. isBlockNode
  411. ^true
  412. ! !
  413. !BlockNode methodsFor: 'visiting'!
  414. accept: aVisitor
  415. aVisitor visitBlockNode: self
  416. ! !
  417. Node subclass: #SequenceNode
  418. instanceVariableNames: 'temps'
  419. category: 'Compiler'!
  420. !SequenceNode methodsFor: 'accessing'!
  421. temps
  422. ^temps ifNil: [#()]
  423. !
  424. temps: aCollection
  425. temps := aCollection
  426. ! !
  427. !SequenceNode methodsFor: 'testing'!
  428. asBlockSequenceNode
  429. ^BlockSequenceNode new
  430. nodes: self nodes;
  431. temps: self temps;
  432. yourself
  433. ! !
  434. !SequenceNode methodsFor: 'visiting'!
  435. accept: aVisitor
  436. aVisitor visitSequenceNode: self
  437. ! !
  438. SequenceNode subclass: #BlockSequenceNode
  439. instanceVariableNames: ''
  440. category: 'Compiler'!
  441. !BlockSequenceNode methodsFor: 'testing'!
  442. isBlockSequenceNode
  443. ^true
  444. ! !
  445. !BlockSequenceNode methodsFor: 'visiting'!
  446. accept: aVisitor
  447. aVisitor visitBlockSequenceNode: self
  448. ! !
  449. Node subclass: #ReturnNode
  450. instanceVariableNames: ''
  451. category: 'Compiler'!
  452. !ReturnNode methodsFor: 'visiting'!
  453. accept: aVisitor
  454. aVisitor visitReturnNode: self
  455. ! !
  456. Node subclass: #ValueNode
  457. instanceVariableNames: 'value'
  458. category: 'Compiler'!
  459. !ValueNode methodsFor: 'accessing'!
  460. value
  461. ^value
  462. !
  463. value: anObject
  464. value := anObject
  465. ! !
  466. !ValueNode methodsFor: 'testing'!
  467. isValueNode
  468. ^true
  469. ! !
  470. !ValueNode methodsFor: 'visiting'!
  471. accept: aVisitor
  472. aVisitor visitValueNode: self
  473. ! !
  474. ValueNode subclass: #VariableNode
  475. instanceVariableNames: 'assigned'
  476. category: 'Compiler'!
  477. !VariableNode methodsFor: 'accessing'!
  478. assigned
  479. ^assigned ifNil: [false]
  480. !
  481. assigned: aBoolean
  482. assigned := aBoolean
  483. ! !
  484. !VariableNode methodsFor: 'visiting'!
  485. accept: aVisitor
  486. aVisitor visitVariableNode: self
  487. ! !
  488. VariableNode subclass: #ClassReferenceNode
  489. instanceVariableNames: ''
  490. category: 'Compiler'!
  491. !ClassReferenceNode methodsFor: 'visiting'!
  492. accept: aVisitor
  493. aVisitor visitClassReferenceNode: self
  494. ! !
  495. Node subclass: #JSStatementNode
  496. instanceVariableNames: 'source'
  497. category: 'Compiler'!
  498. !JSStatementNode methodsFor: 'accessing'!
  499. source
  500. ^source ifNil: ['']
  501. !
  502. source: aString
  503. source := aString
  504. ! !
  505. !JSStatementNode methodsFor: 'visiting'!
  506. accept: aVisitor
  507. aVisitor visitJSStatementNode: self
  508. ! !
  509. Object subclass: #NodeVisitor
  510. instanceVariableNames: ''
  511. category: 'Compiler'!
  512. !NodeVisitor methodsFor: 'visiting'!
  513. visit: aNode
  514. aNode accept: self
  515. !
  516. visitNode: aNode
  517. !
  518. visitMethodNode: aNode
  519. self visitNode: aNode
  520. !
  521. visitSequenceNode: aNode
  522. self visitNode: aNode
  523. !
  524. visitBlockSequenceNode: aNode
  525. self visitSequenceNode: aNode
  526. !
  527. visitBlockNode: aNode
  528. self visitNode: aNode
  529. !
  530. visitReturnNode: aNode
  531. self visitNode: aNode
  532. !
  533. visitSendNode: aNode
  534. self visitNode: aNode
  535. !
  536. visitCascadeNode: aNode
  537. self visitNode: aNode
  538. !
  539. visitValueNode: aNode
  540. self visitNode: aNode
  541. !
  542. visitVariableNode: aNode
  543. !
  544. visitAssignmentNode: aNode
  545. self visitNode: aNode
  546. !
  547. visitClassReferenceNode: aNode
  548. self
  549. nextPutAll: 'smalltalk.';
  550. nextPutAll: aNode value
  551. !
  552. visitJSStatementNode: aNode
  553. self
  554. nextPutAll: 'function(){';
  555. nextPutAll: aNode source;
  556. nextPutAll: '})()'
  557. !
  558. visitDynamicArrayNode: aNode
  559. self visitNode: aNode
  560. !
  561. visitDynamicDictionaryNode: aNode
  562. self visitNode: aNode
  563. ! !
  564. NodeVisitor subclass: #Compiler
  565. instanceVariableNames: 'stream nestedBlocks earlyReturn currentClass currentSelector unknownVariables tempVariables messageSends referencedClasses classReferenced source argVariables'
  566. category: 'Compiler'!
  567. !Compiler methodsFor: 'accessing'!
  568. parser
  569. ^SmalltalkParser new
  570. !
  571. currentClass
  572. ^currentClass
  573. !
  574. currentClass: aClass
  575. currentClass := aClass
  576. !
  577. unknownVariables
  578. ^unknownVariables copy
  579. !
  580. pseudoVariables
  581. ^#('self' 'super' 'true' 'false' 'nil' 'thisContext')
  582. !
  583. tempVariables
  584. ^tempVariables copy
  585. !
  586. knownVariables
  587. ^self pseudoVariables
  588. addAll: self tempVariables;
  589. addAll: self argVariables;
  590. yourself
  591. !
  592. classNameFor: aClass
  593. ^aClass isMetaclass
  594. ifTrue: [aClass instanceClass name, '.klass']
  595. ifFalse: [
  596. aClass isNil
  597. ifTrue: ['nil']
  598. ifFalse: [aClass name]]
  599. !
  600. source
  601. ^source ifNil: ['']
  602. !
  603. source: aString
  604. source := aString
  605. !
  606. argVariables
  607. ^argVariables copy
  608. ! !
  609. !Compiler methodsFor: 'compiling'!
  610. loadExpression: aString
  611. | result |
  612. DoIt addCompiledMethod: (self eval: (self compileExpression: aString)).
  613. result := DoIt new doIt.
  614. DoIt removeCompiledMethod: (DoIt methodDictionary at: #doIt).
  615. ^result
  616. !
  617. load: aString forClass: aClass
  618. | compiled |
  619. compiled := self eval: (self compile: aString forClass: aClass).
  620. self setupClass: aClass.
  621. ^compiled
  622. !
  623. compile: aString forClass: aClass
  624. self currentClass: aClass.
  625. self source: aString.
  626. ^self compile: aString
  627. !
  628. compileExpression: aString
  629. self currentClass: DoIt.
  630. self source: 'doIt ^[', aString, '] value'.
  631. ^self compileNode: (self parse: self source)
  632. !
  633. eval: aString
  634. <return eval(aString)>
  635. !
  636. compile: aString
  637. ^self compileNode: (self parse: aString)
  638. !
  639. compileNode: aNode
  640. stream := '' writeStream.
  641. self visit: aNode.
  642. ^stream contents
  643. !
  644. parse: aString
  645. ^Smalltalk current parse: aString
  646. !
  647. parseExpression: aString
  648. ^self parse: 'doIt ^[', aString, '] value'
  649. !
  650. recompile: aClass
  651. aClass methodDictionary do: [:each || method |
  652. method := self load: each source forClass: aClass.
  653. method category: each category.
  654. aClass addCompiledMethod: method].
  655. aClass isMetaclass ifFalse: [self recompile: aClass class]
  656. !
  657. recompileAll
  658. Smalltalk current classes do: [:each |
  659. Transcript show: each; cr.
  660. [self recompile: each] valueWithTimeout: 100]
  661. !
  662. setupClass: aClass
  663. <smalltalk.init(aClass)>
  664. ! !
  665. !Compiler methodsFor: 'initialization'!
  666. initialize
  667. super initialize.
  668. stream := '' writeStream.
  669. unknownVariables := #().
  670. tempVariables := #().
  671. argVariables := #().
  672. messageSends := #().
  673. classReferenced := #()
  674. ! !
  675. !Compiler methodsFor: 'optimizations'!
  676. checkClass: aClassName for: receiver
  677. stream nextPutAll: '(($receiver = ', receiver, ').klass === smalltalk.', aClassName, ') ? '
  678. !
  679. inlineLiteral: aSelector receiverNode: anObject argumentNodes: aCollection
  680. | inlined |
  681. inlined := false.
  682. "-- BlockClosures --"
  683. (aSelector = 'whileTrue:') ifTrue: [
  684. (anObject isBlockNode and: [aCollection first isBlockNode]) ifTrue: [
  685. stream nextPutAll: '(function(){while('.
  686. self visit: anObject.
  687. stream nextPutAll: '()) {'.
  688. self visit: aCollection first.
  689. stream nextPutAll: '()}})()'.
  690. inlined := true]].
  691. (aSelector = 'whileFalse:') ifTrue: [
  692. (anObject isBlockNode and: [aCollection first isBlockNode]) ifTrue: [
  693. stream nextPutAll: '(function(){while(!!'.
  694. self visit: anObject.
  695. stream nextPutAll: '()) {'.
  696. self visit: aCollection first.
  697. stream nextPutAll: '()}})()'.
  698. inlined := true]].
  699. (aSelector = 'whileTrue') ifTrue: [
  700. anObject isBlockNode ifTrue: [
  701. stream nextPutAll: '(function(){while('.
  702. self visit: anObject.
  703. stream nextPutAll: '()) {}})()'.
  704. inlined := true]].
  705. (aSelector = 'whileFalse') ifTrue: [
  706. anObject isBlockNode ifTrue: [
  707. stream nextPutAll: '(function(){while(!!'.
  708. self visit: anObject.
  709. stream nextPutAll: '()) {}})()'.
  710. inlined := true]].
  711. "-- Numbers --"
  712. (aSelector = '+') ifTrue: [
  713. (self isNode: anObject ofClass: Number) ifTrue: [
  714. self visit: anObject.
  715. stream nextPutAll: ' + '.
  716. self visit: aCollection first.
  717. inlined := true]].
  718. (aSelector = '-') ifTrue: [
  719. (self isNode: anObject ofClass: Number) ifTrue: [
  720. self visit: anObject.
  721. stream nextPutAll: ' - '.
  722. self visit: aCollection first.
  723. inlined := true]].
  724. (aSelector = '*') ifTrue: [
  725. (self isNode: anObject ofClass: Number) ifTrue: [
  726. self visit: anObject.
  727. stream nextPutAll: ' * '.
  728. self visit: aCollection first.
  729. inlined := true]].
  730. (aSelector = '/') ifTrue: [
  731. (self isNode: anObject ofClass: Number) ifTrue: [
  732. self visit: anObject.
  733. stream nextPutAll: ' / '.
  734. self visit: aCollection first.
  735. inlined := true]].
  736. (aSelector = '<') ifTrue: [
  737. (self isNode: anObject ofClass: Number) ifTrue: [
  738. self visit: anObject.
  739. stream nextPutAll: ' < '.
  740. self visit: aCollection first.
  741. inlined := true]].
  742. (aSelector = '<=') ifTrue: [
  743. (self isNode: anObject ofClass: Number) ifTrue: [
  744. self visit: anObject.
  745. stream nextPutAll: ' <= '.
  746. self visit: aCollection first.
  747. inlined := true]].
  748. (aSelector = '>') ifTrue: [
  749. (self isNode: anObject ofClass: Number) ifTrue: [
  750. self visit: anObject.
  751. stream nextPutAll: ' > '.
  752. self visit: aCollection first.
  753. inlined := true]].
  754. (aSelector = '>=') ifTrue: [
  755. (self isNode: anObject ofClass: Number) ifTrue: [
  756. self visit: anObject.
  757. stream nextPutAll: ' >= '.
  758. self visit: aCollection first.
  759. inlined := true]].
  760. "-- UndefinedObject --"
  761. (aSelector = 'ifNil:') ifTrue: [
  762. aCollection first isBlockNode ifTrue: [
  763. stream nextPutAll: '(($receiver = '.
  764. self visit: anObject.
  765. stream nextPutAll: ') == nil || $receiver == undefined) ? '.
  766. self visit: aCollection first.
  767. stream nextPutAll: '() : $receiver'.
  768. inlined := true]].
  769. (aSelector = 'ifNotNil:') ifTrue: [
  770. aCollection first isBlockNode ifTrue: [
  771. stream nextPutAll: '(($receiver = '.
  772. self visit: anObject.
  773. stream nextPutAll: ') !!= nil && $receiver !!= undefined) ? '.
  774. self visit: aCollection first.
  775. stream nextPutAll: '() : nil'.
  776. inlined := true]].
  777. (aSelector = 'ifNil:ifNotNil:') ifTrue: [
  778. (aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
  779. stream nextPutAll: '(($receiver = '.
  780. self visit: anObject.
  781. stream nextPutAll: ') == nil || $receiver == undefined) ? '.
  782. self visit: aCollection first.
  783. stream nextPutAll: '() : '.
  784. self visit: aCollection second.
  785. stream nextPutAll: '()'.
  786. inlined := true]].
  787. (aSelector = 'ifNotNil:ifNil:') ifTrue: [
  788. (aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
  789. stream nextPutAll: '(($receiver = '.
  790. self visit: anObject.
  791. stream nextPutAll: ') == nil || $receiver == undefined) ? '.
  792. self visit: aCollection second.
  793. stream nextPutAll: '() : '.
  794. self visit: aCollection first.
  795. stream nextPutAll: '()'.
  796. inlined := true]].
  797. ^inlined
  798. !
  799. isNode: aNode ofClass: aClass
  800. ^aNode isValueNode and: [
  801. aNode value class = aClass or: [
  802. aNode value = 'self' and: [self currentClass = aClass]]]
  803. !
  804. inline: aSelector receiver: receiver argumentNodes: aCollection
  805. | inlined |
  806. inlined := false.
  807. "-- Booleans --"
  808. (aSelector = 'ifFalse:') ifTrue: [
  809. aCollection first isBlockNode ifTrue: [
  810. self checkClass: 'Boolean' for: receiver.
  811. stream nextPutAll: '(!! $receiver ? '.
  812. self visit: aCollection first.
  813. stream nextPutAll: '() : nil)'.
  814. inlined := true]].
  815. (aSelector = 'ifTrue:') ifTrue: [
  816. aCollection first isBlockNode ifTrue: [
  817. self checkClass: 'Boolean' for: receiver.
  818. stream nextPutAll: '($receiver ? '.
  819. self visit: aCollection first.
  820. stream nextPutAll: '() : nil)'.
  821. inlined := true]].
  822. (aSelector = 'ifTrue:ifFalse:') ifTrue: [
  823. (aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
  824. self checkClass: 'Boolean' for: receiver.
  825. stream nextPutAll: '($receiver ? '.
  826. self visit: aCollection first.
  827. stream nextPutAll: '() : '.
  828. self visit: aCollection second.
  829. stream nextPutAll: '())'.
  830. inlined := true]].
  831. (aSelector = 'ifFalse:ifTrue:') ifTrue: [
  832. (aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
  833. self checkClass: 'Boolean' for: receiver.
  834. stream nextPutAll: '(!! $receiver ? '.
  835. self visit: aCollection first.
  836. stream nextPutAll: '() : '.
  837. self visit: aCollection second.
  838. stream nextPutAll: '())'.
  839. inlined := true]].
  840. "-- Numbers --"
  841. (aSelector = '<') ifTrue: [
  842. self checkClass: 'Number' for: receiver.
  843. stream nextPutAll: '$receiver <'.
  844. self visit: aCollection first.
  845. inlined := true].
  846. (aSelector = '<=') ifTrue: [
  847. self checkClass: 'Number' for: receiver.
  848. stream nextPutAll: '$receiver <='.
  849. self visit: aCollection first.
  850. inlined := true].
  851. (aSelector = '>') ifTrue: [
  852. self checkClass: 'Number' for: receiver.
  853. stream nextPutAll: '$receiver >'.
  854. self visit: aCollection first.
  855. inlined := true].
  856. (aSelector = '>=') ifTrue: [
  857. self checkClass: 'Number' for: receiver.
  858. stream nextPutAll: '$receiver >='.
  859. self visit: aCollection first.
  860. inlined := true].
  861. (aSelector = '+') ifTrue: [
  862. self checkClass: 'Number' for: receiver.
  863. stream nextPutAll: '$receiver +'.
  864. self visit: aCollection first.
  865. inlined := true].
  866. (aSelector = '-') ifTrue: [
  867. self checkClass: 'Number' for: receiver.
  868. stream nextPutAll: '$receiver -'.
  869. self visit: aCollection first.
  870. inlined := true].
  871. (aSelector = '*') ifTrue: [
  872. self checkClass: 'Number' for: receiver.
  873. stream nextPutAll: '$receiver *'.
  874. self visit: aCollection first.
  875. inlined := true].
  876. (aSelector = '/') ifTrue: [
  877. self checkClass: 'Number' for: receiver.
  878. stream nextPutAll: '$receiver /'.
  879. self visit: aCollection first.
  880. inlined := true].
  881. ^inlined
  882. ! !
  883. !Compiler methodsFor: 'testing'!
  884. performOptimizations
  885. ^self class performOptimizations
  886. ! !
  887. !Compiler methodsFor: 'visiting'!
  888. visit: aNode
  889. aNode accept: self
  890. !
  891. visitMethodNode: aNode
  892. | str currentSelector |
  893. currentSelector := aNode selector asSelector.
  894. nestedBlocks := 0.
  895. earlyReturn := false.
  896. messageSends := #().
  897. referencedClasses := #().
  898. unknownVariables := #().
  899. tempVariables := #().
  900. argVariables := #().
  901. stream
  902. nextPutAll: 'smalltalk.method({'; lf;
  903. nextPutAll: 'selector: "', aNode selector, '",'; lf.
  904. stream nextPutAll: 'source: unescape("', self source escaped, '"),';lf.
  905. stream nextPutAll: 'fn: function('.
  906. aNode arguments
  907. do: [:each |
  908. argVariables add: each.
  909. stream nextPutAll: each]
  910. separatedBy: [stream nextPutAll: ', '].
  911. stream
  912. nextPutAll: '){'; lf;
  913. nextPutAll: 'var self=this;'; lf.
  914. str := stream.
  915. stream := '' writeStream.
  916. aNode nodes do: [:each |
  917. self visit: each].
  918. earlyReturn ifTrue: [
  919. str nextPutAll: 'try{'].
  920. str nextPutAll: stream contents.
  921. stream := str.
  922. stream
  923. lf;
  924. nextPutAll: 'return self;'.
  925. earlyReturn ifTrue: [
  926. stream lf; nextPutAll: '} catch(e) {if(e.name === ''stReturn'' && e.selector === ', currentSelector printString, '){return e.fn()} throw(e)}'].
  927. stream nextPutAll: '}'.
  928. stream
  929. nextPutAll: ',', String lf, 'messageSends: ';
  930. nextPutAll: messageSends asJavascript, ','; lf;
  931. nextPutAll: 'args: ', argVariables asJavascript, ','; lf;
  932. nextPutAll: 'referencedClasses: ['.
  933. referencedClasses
  934. do: [:each | stream nextPutAll: each]
  935. separatedBy: [stream nextPutAll: ','].
  936. stream nextPutAll: ']'.
  937. stream nextPutAll: '})'
  938. !
  939. visitBlockNode: aNode
  940. stream nextPutAll: '(function('.
  941. aNode parameters
  942. do: [:each |
  943. tempVariables add: each.
  944. stream nextPutAll: each]
  945. separatedBy: [stream nextPutAll: ', '].
  946. stream nextPutAll: '){'.
  947. aNode nodes do: [:each | self visit: each].
  948. stream nextPutAll: '})'
  949. !
  950. visitSequenceNode: aNode
  951. aNode temps do: [:each |
  952. tempVariables add: each.
  953. stream nextPutAll: 'var ', each, '=nil;'; lf].
  954. aNode nodes do: [:each |
  955. self visit: each.
  956. stream nextPutAll: ';']
  957. separatedBy: [stream lf]
  958. !
  959. visitBlockSequenceNode: aNode
  960. | index |
  961. nestedBlocks := nestedBlocks + 1.
  962. aNode nodes isEmpty
  963. ifTrue: [
  964. stream nextPutAll: 'return nil;']
  965. ifFalse: [
  966. aNode temps do: [:each |
  967. tempVariables add: each.
  968. stream nextPutAll: 'var ', each, '=nil;'; lf].
  969. index := 0.
  970. aNode nodes do: [:each |
  971. index := index + 1.
  972. index = aNode nodes size ifTrue: [
  973. stream nextPutAll: 'return '].
  974. self visit: each.
  975. stream nextPutAll: ';']].
  976. nestedBlocks := nestedBlocks - 1
  977. !
  978. visitReturnNode: aNode
  979. nestedBlocks > 0 ifTrue: [
  980. earlyReturn := true].
  981. earlyReturn
  982. ifTrue: [
  983. stream
  984. nextPutAll: '(function(){throw(';
  985. nextPutAll: '{name: ''stReturn'', selector: ';
  986. nextPutAll: currentSelector printString;
  987. nextPutAll: ', fn: function(){return ']
  988. ifFalse: [stream nextPutAll: 'return '].
  989. aNode nodes do: [:each |
  990. self visit: each].
  991. earlyReturn ifTrue: [
  992. stream nextPutAll: '}})})()']
  993. !
  994. visitSendNode: aNode
  995. | str receiver superSend inlined |
  996. str := stream.
  997. (messageSends includes: aNode selector) ifFalse: [
  998. messageSends add: aNode selector].
  999. stream := '' writeStream.
  1000. self visit: aNode receiver.
  1001. superSend := stream contents = 'super'.
  1002. receiver := superSend ifTrue: ['self'] ifFalse: [stream contents].
  1003. stream := str.
  1004. self performOptimizations
  1005. ifTrue: [
  1006. (self inlineLiteral: aNode selector receiverNode: aNode receiver argumentNodes: aNode arguments) ifFalse: [
  1007. (self inline: aNode selector receiver: receiver argumentNodes: aNode arguments)
  1008. ifTrue: [stream nextPutAll: ' : ', (self send: aNode selector to: '$receiver' arguments: aNode arguments superSend: superSend)]
  1009. ifFalse: [stream nextPutAll: (self send: aNode selector to: receiver arguments: aNode arguments superSend: superSend)]]]
  1010. ifFalse: [stream nextPutAll: (self send: aNode selector to: receiver arguments: aNode arguments superSend: superSend)]
  1011. !
  1012. visitCascadeNode: aNode
  1013. | index |
  1014. index := 0.
  1015. (tempVariables includes: '$rec') ifFalse: [
  1016. tempVariables add: '$rec'].
  1017. stream nextPutAll: '(function($rec){'.
  1018. aNode nodes do: [:each |
  1019. index := index + 1.
  1020. index = aNode nodes size ifTrue: [
  1021. stream nextPutAll: 'return '].
  1022. each receiver: (VariableNode new value: '$rec').
  1023. self visit: each.
  1024. stream nextPutAll: ';'].
  1025. stream nextPutAll: '})('.
  1026. self visit: aNode receiver.
  1027. stream nextPutAll: ')'
  1028. !
  1029. visitValueNode: aNode
  1030. stream nextPutAll: aNode value asJavascript
  1031. !
  1032. visitAssignmentNode: aNode
  1033. self visit: aNode left.
  1034. stream nextPutAll: '='.
  1035. self visit: aNode right
  1036. !
  1037. visitClassReferenceNode: aNode
  1038. | klass |
  1039. klass := '(smalltalk.', aNode value, ' || ', aNode value, ')'.
  1040. (Smalltalk current at: aNode value) isClass ifTrue: [
  1041. (referencedClasses includes: klass)
  1042. ifFalse: [referencedClasses add: klass]].
  1043. stream nextPutAll: klass
  1044. !
  1045. visitVariableNode: aNode
  1046. (self currentClass allInstanceVariableNames includes: aNode value)
  1047. ifTrue: [stream nextPutAll: 'self[''@', aNode value, ''']']
  1048. ifFalse: [
  1049. (self knownVariables includes: aNode value)
  1050. ifFalse: [
  1051. unknownVariables add: aNode value.
  1052. aNode assigned
  1053. ifTrue: [stream nextPutAll: aNode value]
  1054. ifFalse: [stream nextPutAll: '(typeof ', aNode value, ' == ''undefined'' ? nil : ', aNode value, ')']]
  1055. ifTrue: [
  1056. aNode value = 'thisContext'
  1057. ifTrue: [stream nextPutAll: '(smalltalk.getThisContext())']
  1058. ifFalse: [stream nextPutAll:aNode value]]]
  1059. !
  1060. visitJSStatementNode: aNode
  1061. stream nextPutAll: (aNode source replace: '>>' with: '>')
  1062. !
  1063. visitFailure: aFailure
  1064. self error: aFailure asString
  1065. !
  1066. send: aSelector to: aReceiver arguments: aCollection superSend: aBoolean
  1067. ^String streamContents: [:str || tmp |
  1068. tmp := stream.
  1069. str nextPutAll: 'smalltalk.send('.
  1070. str nextPutAll: aReceiver.
  1071. str nextPutAll: ', "', aSelector asSelector, '", ['.
  1072. stream := str.
  1073. aCollection
  1074. do: [:each | self visit: each]
  1075. separatedBy: [stream nextPutAll: ', '].
  1076. stream := tmp.
  1077. str nextPutAll: ']'.
  1078. aBoolean ifTrue: [
  1079. str nextPutAll: ', smalltalk.', (self classNameFor: self currentClass superclass)].
  1080. str nextPutAll: ')']
  1081. !
  1082. visitDynamicArrayNode: aNode
  1083. stream nextPutAll: '['.
  1084. aNode nodes
  1085. do: [:each | self visit: each]
  1086. separatedBy: [stream nextPutAll: ','].
  1087. stream nextPutAll: ']'
  1088. !
  1089. visitDynamicDictionaryNode: aNode
  1090. stream nextPutAll: 'smalltalk.Dictionary._fromPairs_(['.
  1091. aNode nodes
  1092. do: [:each | self visit: each]
  1093. separatedBy: [stream nextPutAll: ','].
  1094. stream nextPutAll: '])'
  1095. ! !
  1096. Compiler class instanceVariableNames: 'performOptimizations'!
  1097. !Compiler class methodsFor: 'accessing'!
  1098. performOptimizations
  1099. ^performOptimizations ifNil: [true]
  1100. !
  1101. performOptimizations: aBoolean
  1102. performOptimizations := aBoolean
  1103. ! !
  1104. !Compiler class methodsFor: 'compiling'!
  1105. recompile: aClass
  1106. aClass methodDictionary do: [:each || method |
  1107. method := self new load: each source forClass: aClass.
  1108. method category: each category.
  1109. aClass addCompiledMethod: method].
  1110. aClass isMetaclass ifFalse: [self recompile: aClass class]
  1111. !
  1112. recompileAll
  1113. Smalltalk current classes do: [:each |
  1114. self recompile: each]
  1115. ! !
  1116. Object subclass: #DoIt
  1117. instanceVariableNames: ''
  1118. category: 'Compiler'!
  1119. Node subclass: #DynamicArrayNode
  1120. instanceVariableNames: ''
  1121. category: 'Compiler'!
  1122. !DynamicArrayNode methodsFor: 'visiting'!
  1123. accept: aVisitor
  1124. aVisitor visitDynamicArrayNode: self
  1125. ! !
  1126. Node subclass: #DynamicDictionaryNode
  1127. instanceVariableNames: ''
  1128. category: 'Compiler'!
  1129. !DynamicDictionaryNode methodsFor: 'visiting'!
  1130. accept: aVisitor
  1131. aVisitor visitDynamicDictionaryNode: self
  1132. ! !