1
0

Compiler.st 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407
  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. safeVariableNameFor: aString
  610. ^(Smalltalk current reservedWords includes: aString)
  611. ifTrue: [aString, '_']
  612. ifFalse: [aString]
  613. ! !
  614. !Compiler methodsFor: 'compiling'!
  615. loadExpression: aString
  616. | result |
  617. DoIt addCompiledMethod: (self eval: (self compileExpression: aString)).
  618. result := DoIt new doIt.
  619. DoIt removeCompiledMethod: (DoIt methodDictionary at: #doIt).
  620. ^result
  621. !
  622. load: aString forClass: aClass
  623. | compiled |
  624. compiled := self eval: (self compile: aString forClass: aClass).
  625. self setupClass: aClass.
  626. ^compiled
  627. !
  628. compile: aString forClass: aClass
  629. self currentClass: aClass.
  630. self source: aString.
  631. ^self compile: aString
  632. !
  633. compileExpression: aString
  634. self currentClass: DoIt.
  635. self source: 'doIt ^[', aString, '] value'.
  636. ^self compileNode: (self parse: self source)
  637. !
  638. eval: aString
  639. <return eval(aString)>
  640. !
  641. compile: aString
  642. ^self compileNode: (self parse: aString)
  643. !
  644. compileNode: aNode
  645. stream := '' writeStream.
  646. self visit: aNode.
  647. ^stream contents
  648. !
  649. parse: aString
  650. ^Smalltalk current parse: aString
  651. !
  652. parseExpression: aString
  653. ^self parse: 'doIt ^[', aString, '] value'
  654. !
  655. recompile: aClass
  656. aClass methodDictionary do: [:each || method |
  657. method := self load: each source forClass: aClass.
  658. method category: each category.
  659. aClass addCompiledMethod: method].
  660. aClass isMetaclass ifFalse: [self recompile: aClass class]
  661. !
  662. recompileAll
  663. Smalltalk current classes do: [:each |
  664. Transcript show: each; cr.
  665. [self recompile: each] valueWithTimeout: 100]
  666. !
  667. setupClass: aClass
  668. <smalltalk.init(aClass)>
  669. ! !
  670. !Compiler methodsFor: 'initialization'!
  671. initialize
  672. super initialize.
  673. stream := '' writeStream.
  674. unknownVariables := #().
  675. tempVariables := #().
  676. argVariables := #().
  677. messageSends := #().
  678. classReferenced := #()
  679. ! !
  680. !Compiler methodsFor: 'optimizations'!
  681. checkClass: aClassName for: receiver
  682. stream nextPutAll: '((($receiver = ', receiver, ').klass === smalltalk.', aClassName, ') ? '
  683. !
  684. inlineLiteral: aSelector receiverNode: anObject argumentNodes: aCollection
  685. | inlined |
  686. inlined := false.
  687. "-- BlockClosures --"
  688. (aSelector = 'whileTrue:') ifTrue: [
  689. (anObject isBlockNode and: [aCollection first isBlockNode]) ifTrue: [
  690. stream nextPutAll: '(function(){while('.
  691. self visit: anObject.
  692. stream nextPutAll: '()) {'.
  693. self visit: aCollection first.
  694. stream nextPutAll: '()}})()'.
  695. inlined := true]].
  696. (aSelector = 'whileFalse:') ifTrue: [
  697. (anObject isBlockNode and: [aCollection first isBlockNode]) ifTrue: [
  698. stream nextPutAll: '(function(){while(!!'.
  699. self visit: anObject.
  700. stream nextPutAll: '()) {'.
  701. self visit: aCollection first.
  702. stream nextPutAll: '()}})()'.
  703. inlined := true]].
  704. (aSelector = 'whileTrue') ifTrue: [
  705. anObject isBlockNode ifTrue: [
  706. stream nextPutAll: '(function(){while('.
  707. self visit: anObject.
  708. stream nextPutAll: '()) {}})()'.
  709. inlined := true]].
  710. (aSelector = 'whileFalse') ifTrue: [
  711. anObject isBlockNode ifTrue: [
  712. stream nextPutAll: '(function(){while(!!'.
  713. self visit: anObject.
  714. stream nextPutAll: '()) {}})()'.
  715. inlined := true]].
  716. "-- Numbers --"
  717. (aSelector = '+') ifTrue: [
  718. (self isNode: anObject ofClass: Number) ifTrue: [
  719. self visit: anObject.
  720. stream nextPutAll: ' + '.
  721. self visit: aCollection first.
  722. inlined := true]].
  723. (aSelector = '-') ifTrue: [
  724. (self isNode: anObject ofClass: Number) ifTrue: [
  725. self visit: anObject.
  726. stream nextPutAll: ' - '.
  727. self visit: aCollection first.
  728. inlined := true]].
  729. (aSelector = '*') ifTrue: [
  730. (self isNode: anObject ofClass: Number) ifTrue: [
  731. self visit: anObject.
  732. stream nextPutAll: ' * '.
  733. self visit: aCollection first.
  734. inlined := true]].
  735. (aSelector = '/') ifTrue: [
  736. (self isNode: anObject ofClass: Number) ifTrue: [
  737. self visit: anObject.
  738. stream nextPutAll: ' / '.
  739. self visit: aCollection first.
  740. inlined := true]].
  741. (aSelector = '<') ifTrue: [
  742. (self isNode: anObject ofClass: Number) ifTrue: [
  743. self visit: anObject.
  744. stream nextPutAll: ' < '.
  745. self visit: aCollection first.
  746. inlined := true]].
  747. (aSelector = '<=') ifTrue: [
  748. (self isNode: anObject ofClass: Number) ifTrue: [
  749. self visit: anObject.
  750. stream nextPutAll: ' <= '.
  751. self visit: aCollection first.
  752. inlined := true]].
  753. (aSelector = '>') ifTrue: [
  754. (self isNode: anObject ofClass: Number) ifTrue: [
  755. self visit: anObject.
  756. stream nextPutAll: ' > '.
  757. self visit: aCollection first.
  758. inlined := true]].
  759. (aSelector = '>=') ifTrue: [
  760. (self isNode: anObject ofClass: Number) ifTrue: [
  761. self visit: anObject.
  762. stream nextPutAll: ' >= '.
  763. self visit: aCollection first.
  764. inlined := true]].
  765. "-- UndefinedObject --"
  766. (aSelector = 'ifNil:') ifTrue: [
  767. aCollection first isBlockNode ifTrue: [
  768. stream nextPutAll: '(($receiver = '.
  769. self visit: anObject.
  770. stream nextPutAll: ') == nil || $receiver == undefined) ? '.
  771. self visit: aCollection first.
  772. stream nextPutAll: '() : $receiver'.
  773. inlined := true]].
  774. (aSelector = 'ifNotNil:') ifTrue: [
  775. aCollection first isBlockNode ifTrue: [
  776. stream nextPutAll: '(($receiver = '.
  777. self visit: anObject.
  778. stream nextPutAll: ') !!= nil && $receiver !!= undefined) ? '.
  779. self visit: aCollection first.
  780. stream nextPutAll: '() : nil'.
  781. inlined := true]].
  782. (aSelector = 'ifNil:ifNotNil:') ifTrue: [
  783. (aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
  784. stream nextPutAll: '(($receiver = '.
  785. self visit: anObject.
  786. stream nextPutAll: ') == nil || $receiver == undefined) ? '.
  787. self visit: aCollection first.
  788. stream nextPutAll: '() : '.
  789. self visit: aCollection second.
  790. stream nextPutAll: '()'.
  791. inlined := true]].
  792. (aSelector = 'ifNotNil:ifNil:') ifTrue: [
  793. (aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
  794. stream nextPutAll: '(($receiver = '.
  795. self visit: anObject.
  796. stream nextPutAll: ') == nil || $receiver == undefined) ? '.
  797. self visit: aCollection second.
  798. stream nextPutAll: '() : '.
  799. self visit: aCollection first.
  800. stream nextPutAll: '()'.
  801. inlined := true]].
  802. ^inlined
  803. !
  804. isNode: aNode ofClass: aClass
  805. ^aNode isValueNode and: [
  806. aNode value class = aClass or: [
  807. aNode value = 'self' and: [self currentClass = aClass]]]
  808. !
  809. inline: aSelector receiver: receiver argumentNodes: aCollection
  810. | inlined |
  811. inlined := false.
  812. "-- Booleans --"
  813. (aSelector = 'ifFalse:') ifTrue: [
  814. aCollection first isBlockNode ifTrue: [
  815. self checkClass: 'Boolean' for: receiver.
  816. stream nextPutAll: '(!! $receiver ? '.
  817. self visit: aCollection first.
  818. stream nextPutAll: '() : nil)'.
  819. inlined := true]].
  820. (aSelector = 'ifTrue:') ifTrue: [
  821. aCollection first isBlockNode ifTrue: [
  822. self checkClass: 'Boolean' for: receiver.
  823. stream nextPutAll: '($receiver ? '.
  824. self visit: aCollection first.
  825. stream nextPutAll: '() : nil)'.
  826. inlined := true]].
  827. (aSelector = 'ifTrue:ifFalse:') ifTrue: [
  828. (aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
  829. self checkClass: 'Boolean' for: receiver.
  830. stream nextPutAll: '($receiver ? '.
  831. self visit: aCollection first.
  832. stream nextPutAll: '() : '.
  833. self visit: aCollection second.
  834. stream nextPutAll: '())'.
  835. inlined := true]].
  836. (aSelector = 'ifFalse:ifTrue:') ifTrue: [
  837. (aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
  838. self checkClass: 'Boolean' for: receiver.
  839. stream nextPutAll: '(!! $receiver ? '.
  840. self visit: aCollection first.
  841. stream nextPutAll: '() : '.
  842. self visit: aCollection second.
  843. stream nextPutAll: '())'.
  844. inlined := true]].
  845. "-- Numbers --"
  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. (aSelector = '/') ifTrue: [
  882. self checkClass: 'Number' for: receiver.
  883. stream nextPutAll: '$receiver /'.
  884. self visit: aCollection first.
  885. inlined := true].
  886. ^inlined
  887. ! !
  888. !Compiler methodsFor: 'testing'!
  889. performOptimizations
  890. ^self class performOptimizations
  891. ! !
  892. !Compiler methodsFor: 'visiting'!
  893. visit: aNode
  894. aNode accept: self
  895. !
  896. visitMethodNode: aNode
  897. | str currentSelector |
  898. currentSelector := aNode selector asSelector.
  899. nestedBlocks := 0.
  900. earlyReturn := false.
  901. messageSends := #().
  902. referencedClasses := #().
  903. unknownVariables := #().
  904. tempVariables := #().
  905. argVariables := #().
  906. stream
  907. nextPutAll: 'smalltalk.method({'; lf;
  908. nextPutAll: 'selector: "', aNode selector, '",'; lf.
  909. stream nextPutAll: 'source: unescape("', self source escaped, '"),';lf.
  910. stream nextPutAll: 'fn: function('.
  911. aNode arguments
  912. do: [:each |
  913. argVariables add: each.
  914. stream nextPutAll: each]
  915. separatedBy: [stream nextPutAll: ', '].
  916. stream
  917. nextPutAll: '){'; lf;
  918. nextPutAll: 'var self=this;'; lf.
  919. str := stream.
  920. stream := '' writeStream.
  921. aNode nodes do: [:each |
  922. self visit: each].
  923. earlyReturn ifTrue: [
  924. str nextPutAll: 'try{'].
  925. str nextPutAll: stream contents.
  926. stream := str.
  927. stream
  928. lf;
  929. nextPutAll: 'return self;'.
  930. earlyReturn ifTrue: [
  931. stream lf; nextPutAll: '} catch(e) {if(e.name === ''stReturn'' && e.selector === ', currentSelector printString, '){return e.fn()} throw(e)}'].
  932. stream nextPutAll: '}'.
  933. stream
  934. nextPutAll: ',', String lf, 'messageSends: ';
  935. nextPutAll: messageSends asJavascript, ','; lf;
  936. nextPutAll: 'args: ', argVariables asJavascript, ','; lf;
  937. nextPutAll: 'referencedClasses: ['.
  938. referencedClasses
  939. do: [:each | stream nextPutAll: each]
  940. separatedBy: [stream nextPutAll: ','].
  941. stream nextPutAll: ']'.
  942. stream nextPutAll: '})'
  943. !
  944. visitBlockNode: aNode
  945. stream nextPutAll: '(function('.
  946. aNode parameters
  947. do: [:each |
  948. tempVariables add: each.
  949. stream nextPutAll: each]
  950. separatedBy: [stream nextPutAll: ', '].
  951. stream nextPutAll: '){'.
  952. aNode nodes do: [:each | self visit: each].
  953. stream nextPutAll: '})'
  954. !
  955. visitSequenceNode: aNode
  956. aNode temps do: [:each || temp |
  957. temp := self safeVariableNameFor: each.
  958. tempVariables add: temp.
  959. stream nextPutAll: 'var ', temp, '=nil;'; lf].
  960. aNode nodes do: [:each |
  961. self visit: each.
  962. stream nextPutAll: ';']
  963. separatedBy: [stream lf]
  964. !
  965. visitBlockSequenceNode: aNode
  966. | index |
  967. nestedBlocks := nestedBlocks + 1.
  968. aNode nodes isEmpty
  969. ifTrue: [
  970. stream nextPutAll: 'return nil;']
  971. ifFalse: [
  972. aNode temps do: [:each | | temp |
  973. temp := self safeVariableNameFor: each.
  974. tempVariables add: temp.
  975. stream nextPutAll: 'var ', temp, '=nil;'; lf].
  976. index := 0.
  977. aNode nodes do: [:each |
  978. index := index + 1.
  979. index = aNode nodes size ifTrue: [
  980. stream nextPutAll: 'return '].
  981. self visit: each.
  982. stream nextPutAll: ';']].
  983. nestedBlocks := nestedBlocks - 1
  984. !
  985. visitReturnNode: aNode
  986. nestedBlocks > 0 ifTrue: [
  987. earlyReturn := true].
  988. earlyReturn
  989. ifTrue: [
  990. stream
  991. nextPutAll: '(function(){throw(';
  992. nextPutAll: '{name: ''stReturn'', selector: ';
  993. nextPutAll: currentSelector printString;
  994. nextPutAll: ', fn: function(){return ']
  995. ifFalse: [stream nextPutAll: 'return '].
  996. aNode nodes do: [:each |
  997. self visit: each].
  998. earlyReturn ifTrue: [
  999. stream nextPutAll: '}})})()']
  1000. !
  1001. visitSendNode: aNode
  1002. | str receiver superSend inlined |
  1003. str := stream.
  1004. (messageSends includes: aNode selector) ifFalse: [
  1005. messageSends add: aNode selector].
  1006. stream := '' writeStream.
  1007. self visit: aNode receiver.
  1008. superSend := stream contents = 'super'.
  1009. receiver := superSend ifTrue: ['self'] ifFalse: [stream contents].
  1010. stream := str.
  1011. self performOptimizations
  1012. ifTrue: [
  1013. (self inlineLiteral: aNode selector receiverNode: aNode receiver argumentNodes: aNode arguments) ifFalse: [
  1014. (self inline: aNode selector receiver: receiver argumentNodes: aNode arguments)
  1015. ifTrue: [stream nextPutAll: ' : ', (self send: aNode selector to: '$receiver' arguments: aNode arguments superSend: superSend), ')']
  1016. ifFalse: [stream nextPutAll: (self send: aNode selector to: receiver arguments: aNode arguments superSend: superSend)]]]
  1017. ifFalse: [stream nextPutAll: (self send: aNode selector to: receiver arguments: aNode arguments superSend: superSend)]
  1018. !
  1019. visitCascadeNode: aNode
  1020. | index |
  1021. index := 0.
  1022. (tempVariables includes: '$rec') ifFalse: [
  1023. tempVariables add: '$rec'].
  1024. stream nextPutAll: '(function($rec){'.
  1025. aNode nodes do: [:each |
  1026. index := index + 1.
  1027. index = aNode nodes size ifTrue: [
  1028. stream nextPutAll: 'return '].
  1029. each receiver: (VariableNode new value: '$rec').
  1030. self visit: each.
  1031. stream nextPutAll: ';'].
  1032. stream nextPutAll: '})('.
  1033. self visit: aNode receiver.
  1034. stream nextPutAll: ')'
  1035. !
  1036. visitValueNode: aNode
  1037. stream nextPutAll: aNode value asJavascript
  1038. !
  1039. visitAssignmentNode: aNode
  1040. self visit: aNode left.
  1041. stream nextPutAll: '='.
  1042. self visit: aNode right
  1043. !
  1044. visitClassReferenceNode: aNode
  1045. | klass |
  1046. klass := '(smalltalk.', aNode value, ' || ', aNode value, ')'.
  1047. (Smalltalk current at: aNode value) isClass ifTrue: [
  1048. (referencedClasses includes: klass)
  1049. ifFalse: [referencedClasses add: klass]].
  1050. stream nextPutAll: klass
  1051. !
  1052. visitVariableNode: aNode
  1053. | varName |
  1054. (self currentClass allInstanceVariableNames includes: aNode value)
  1055. ifTrue: [stream nextPutAll: 'self[''@', aNode value, ''']']
  1056. ifFalse: [
  1057. varName := self safeVariableNameFor: aNode value.
  1058. (self knownVariables includes: varName)
  1059. ifFalse: [
  1060. unknownVariables add: aNode value.
  1061. aNode assigned
  1062. ifTrue: [stream nextPutAll: varName]
  1063. ifFalse: [stream nextPutAll: '(typeof ', varName, ' == ''undefined'' ? nil : ', varName, ')']]
  1064. ifTrue: [
  1065. aNode value = 'thisContext'
  1066. ifTrue: [stream nextPutAll: '(smalltalk.getThisContext())']
  1067. ifFalse: [stream nextPutAll: varName]]]
  1068. !
  1069. visitJSStatementNode: aNode
  1070. stream nextPutAll: (aNode source replace: '>>' with: '>')
  1071. !
  1072. visitFailure: aFailure
  1073. self error: aFailure asString
  1074. !
  1075. send: aSelector to: aReceiver arguments: aCollection superSend: aBoolean
  1076. ^String streamContents: [:str || tmp |
  1077. tmp := stream.
  1078. str nextPutAll: 'smalltalk.send('.
  1079. str nextPutAll: aReceiver.
  1080. str nextPutAll: ', "', aSelector asSelector, '", ['.
  1081. stream := str.
  1082. aCollection
  1083. do: [:each | self visit: each]
  1084. separatedBy: [stream nextPutAll: ', '].
  1085. stream := tmp.
  1086. str nextPutAll: ']'.
  1087. aBoolean ifTrue: [
  1088. str nextPutAll: ', smalltalk.', (self classNameFor: self currentClass superclass)].
  1089. str nextPutAll: ')']
  1090. !
  1091. visitDynamicArrayNode: aNode
  1092. stream nextPutAll: '['.
  1093. aNode nodes
  1094. do: [:each | self visit: each]
  1095. separatedBy: [stream nextPutAll: ','].
  1096. stream nextPutAll: ']'
  1097. !
  1098. visitDynamicDictionaryNode: aNode
  1099. stream nextPutAll: 'smalltalk.Dictionary._fromPairs_(['.
  1100. aNode nodes
  1101. do: [:each | self visit: each]
  1102. separatedBy: [stream nextPutAll: ','].
  1103. stream nextPutAll: '])'
  1104. ! !
  1105. Compiler class instanceVariableNames: 'performOptimizations'!
  1106. !Compiler class methodsFor: 'accessing'!
  1107. performOptimizations
  1108. ^performOptimizations ifNil: [true]
  1109. !
  1110. performOptimizations: aBoolean
  1111. performOptimizations := aBoolean
  1112. ! !
  1113. !Compiler class methodsFor: 'compiling'!
  1114. recompile: aClass
  1115. aClass methodDictionary do: [:each || method |
  1116. method := self new load: each source forClass: aClass.
  1117. method category: each category.
  1118. aClass addCompiledMethod: method].
  1119. aClass isMetaclass ifFalse: [self recompile: aClass class]
  1120. !
  1121. recompileAll
  1122. Smalltalk current classes do: [:each |
  1123. self recompile: each]
  1124. ! !
  1125. Object subclass: #DoIt
  1126. instanceVariableNames: ''
  1127. category: 'Compiler'!
  1128. Node subclass: #DynamicArrayNode
  1129. instanceVariableNames: ''
  1130. category: 'Compiler'!
  1131. !DynamicArrayNode methodsFor: 'visiting'!
  1132. accept: aVisitor
  1133. aVisitor visitDynamicArrayNode: self
  1134. ! !
  1135. Node subclass: #DynamicDictionaryNode
  1136. instanceVariableNames: ''
  1137. category: 'Compiler'!
  1138. !DynamicDictionaryNode methodsFor: 'visiting'!
  1139. accept: aVisitor
  1140. aVisitor visitDynamicDictionaryNode: self
  1141. ! !