Compiler.st 35 KB

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