Compiler.st 35 KB

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