1
0

Compiler.st 35 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423
  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: '''', aMethod selector asSelector, ''',';lf;
  267. nextPutAll: 'smalltalk.method({';lf;
  268. nextPutAll: 'selector: ''', aMethod selector, ''',';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. self visit: aNode left.
  1057. stream nextPutAll: '='.
  1058. self visit: aNode right
  1059. !
  1060. visitClassReferenceNode: aNode
  1061. (referencedClasses includes: aNode value) ifFalse: [
  1062. referencedClasses add: aNode value].
  1063. stream nextPutAll: '(smalltalk.', aNode value, ' || ', aNode value, ')'
  1064. !
  1065. visitVariableNode: aNode
  1066. | varName |
  1067. (self currentClass allInstanceVariableNames includes: aNode value)
  1068. ifTrue: [stream nextPutAll: 'self[''@', aNode value, ''']']
  1069. ifFalse: [
  1070. varName := self safeVariableNameFor: aNode value.
  1071. (self knownVariables includes: varName)
  1072. ifFalse: [
  1073. unknownVariables add: aNode value.
  1074. aNode assigned
  1075. ifTrue: [stream nextPutAll: varName]
  1076. ifFalse: [stream nextPutAll: '(typeof ', varName, ' == ''undefined'' ? nil : ', varName, ')']]
  1077. ifTrue: [
  1078. aNode value = 'thisContext'
  1079. ifTrue: [stream nextPutAll: '(smalltalk.getThisContext())']
  1080. ifFalse: [stream nextPutAll: varName]]]
  1081. !
  1082. visitJSStatementNode: aNode
  1083. stream nextPutAll: (aNode source replace: '>>' with: '>')
  1084. !
  1085. visitFailure: aFailure
  1086. self error: aFailure asString
  1087. !
  1088. send: aSelector to: aReceiver arguments: aCollection superSend: aBoolean
  1089. ^String streamContents: [:str || tmp |
  1090. tmp := stream.
  1091. str nextPutAll: 'smalltalk.send('.
  1092. str nextPutAll: aReceiver.
  1093. str nextPutAll: ', "', aSelector asSelector, '", ['.
  1094. stream := str.
  1095. aCollection
  1096. do: [:each | self visit: each]
  1097. separatedBy: [stream nextPutAll: ', '].
  1098. stream := tmp.
  1099. str nextPutAll: ']'.
  1100. aBoolean ifTrue: [
  1101. str nextPutAll: ', smalltalk.', (self classNameFor: self currentClass superclass)].
  1102. str nextPutAll: ')']
  1103. !
  1104. visitDynamicArrayNode: aNode
  1105. stream nextPutAll: '['.
  1106. aNode nodes
  1107. do: [:each | self visit: each]
  1108. separatedBy: [stream nextPutAll: ','].
  1109. stream nextPutAll: ']'
  1110. !
  1111. visitDynamicDictionaryNode: aNode
  1112. stream nextPutAll: 'smalltalk.Dictionary._fromPairs_(['.
  1113. aNode nodes
  1114. do: [:each | self visit: each]
  1115. separatedBy: [stream nextPutAll: ','].
  1116. stream nextPutAll: '])'
  1117. ! !
  1118. Compiler class instanceVariableNames: 'performOptimizations'!
  1119. !Compiler class methodsFor: 'accessing'!
  1120. performOptimizations
  1121. ^performOptimizations ifNil: [true]
  1122. !
  1123. performOptimizations: aBoolean
  1124. performOptimizations := aBoolean
  1125. ! !
  1126. !Compiler class methodsFor: 'compiling'!
  1127. recompile: aClass
  1128. aClass methodDictionary do: [:each || method |
  1129. method := self new load: each source forClass: aClass.
  1130. method category: each category.
  1131. aClass addCompiledMethod: method].
  1132. aClass isMetaclass ifFalse: [self recompile: aClass class]
  1133. !
  1134. recompileAll
  1135. Smalltalk current classes do: [:each |
  1136. self recompile: each]
  1137. ! !
  1138. Object subclass: #DoIt
  1139. instanceVariableNames: ''
  1140. category: 'Compiler'!
  1141. Node subclass: #DynamicArrayNode
  1142. instanceVariableNames: ''
  1143. category: 'Compiler'!
  1144. !DynamicArrayNode methodsFor: 'visiting'!
  1145. accept: aVisitor
  1146. aVisitor visitDynamicArrayNode: self
  1147. ! !
  1148. Node subclass: #DynamicDictionaryNode
  1149. instanceVariableNames: ''
  1150. category: 'Compiler'!
  1151. !DynamicDictionaryNode methodsFor: 'visiting'!
  1152. accept: aVisitor
  1153. aVisitor visitDynamicDictionaryNode: self
  1154. ! !