2
0

Compiler-Interpreter.st 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794
  1. Smalltalk createPackage: 'Compiler-Interpreter'!
  2. BlockClosure subclass: #AIBlockClosure
  3. instanceVariableNames: 'node outerContext'
  4. package: 'Compiler-Interpreter'!
  5. !AIBlockClosure commentStamp!
  6. I am a special `BlockClosure` subclass used by an interpreter to interpret a block node.
  7. While I am polymorphic with `BlockClosure`, some methods such as `#new` will raise interpretation errors. Unlike a `BlockClosure`, my instance are not JavaScript functions.
  8. Evaluating an instance will result in interpreting the `node` instance variable (instance of `BlockNode`).!
  9. !AIBlockClosure methodsFor: 'accessing'!
  10. compiledSource
  11. "Unlike blocks, the receiver doesn't represent a JS function"
  12. ^ '[ AST Block closure ]'
  13. !
  14. numArgs
  15. ^ node temps size
  16. ! !
  17. !AIBlockClosure methodsFor: 'converting'!
  18. currySelf
  19. self interpreterError
  20. ! !
  21. !AIBlockClosure methodsFor: 'error handling'!
  22. interpreterError
  23. ASTInterpreterError signal: 'Method cannot be interpreted by the interpreter.'
  24. ! !
  25. !AIBlockClosure methodsFor: 'evaluating'!
  26. applyTo: anObject arguments: aCollection
  27. self interpreterError
  28. !
  29. value
  30. ^ self valueWithPossibleArguments: #()
  31. !
  32. value: anArgument
  33. ^ self valueWithPossibleArguments: {anArgument}
  34. !
  35. value: firstArgument value: secondArgument
  36. ^ self valueWithPossibleArguments: {firstArgument . secondArgument}
  37. !
  38. value: firstArgument value: secondArgument value: thirdArgument
  39. ^ self valueWithPossibleArguments: {firstArgument . secondArgument . thirdArgument}
  40. !
  41. valueWithPossibleArguments: aCollection
  42. | context sequenceNode |
  43. context := outerContext newBlockContext.
  44. "Interpret a copy of the sequence node to avoid creating a new AIBlockClosure"
  45. sequenceNode := node nodes first copy
  46. parent: nil;
  47. yourself.
  48. "Populate the arguments into the context locals"
  49. node parameters withIndexDo: [ :each :index |
  50. context localAt: each put: (aCollection at: index ifAbsent: [ nil ]) ].
  51. "Interpret the first node of the BlockSequenceNode"
  52. context interpreter
  53. node: sequenceNode nextChild;
  54. proceed.
  55. outerContext interpreter
  56. setNonLocalReturnFromContext: context.
  57. ^ context interpreter pop
  58. ! !
  59. !AIBlockClosure methodsFor: 'initialization'!
  60. initializeWithContext: aContext node: aNode
  61. node := aNode.
  62. outerContext := aContext
  63. ! !
  64. !AIBlockClosure class methodsFor: 'instance creation'!
  65. forContext: aContext node: aNode
  66. ^ self new
  67. initializeWithContext: aContext node: aNode;
  68. yourself
  69. ! !
  70. MethodContext subclass: #AIContext
  71. instanceVariableNames: 'outerContext innerContext pc locals selector index sendIndexes evaluatedSelector ast interpreter'
  72. package: 'Compiler-Interpreter'!
  73. !AIContext commentStamp!
  74. I am like a `MethodContext`, used by the `ASTInterpreter`.
  75. Unlike a `MethodContext`, my instances are not read-only.
  76. When debugging, my instances are created by copying the current `MethodContext` (thisContext)!
  77. !AIContext methodsFor: 'accessing'!
  78. evaluatedSelector
  79. ^ evaluatedSelector
  80. !
  81. evaluatedSelector: aString
  82. evaluatedSelector := aString
  83. !
  84. index
  85. ^ index ifNil: [ 0 ]
  86. !
  87. index: anInteger
  88. index := anInteger
  89. !
  90. innerContext
  91. ^ innerContext
  92. !
  93. innerContext: anAIContext
  94. innerContext := anAIContext
  95. !
  96. localAt: aString
  97. "Lookup the local value up to the method context"
  98. ^ self locals at: aString ifAbsent: [
  99. self outerContext ifNotNil: [ :context |
  100. context localAt: aString ] ]
  101. !
  102. localAt: aString ifAbsent: aBlock
  103. "Lookup the local value up to the method context"
  104. ^ self locals at: aString ifAbsent: [
  105. self outerContext
  106. ifNotNil: [ :context | context localAt: aString ifAbsent: aBlock ]
  107. ifNil: [ aBlock value ] ]
  108. !
  109. localAt: aString put: anObject
  110. self locals at: aString put: anObject
  111. !
  112. locals
  113. locals ifNil: [ self initializeLocals ].
  114. ^ locals
  115. !
  116. method
  117. ^ self methodContext ifNotNil: [
  118. self methodContext receiver class lookupSelector: self methodContext selector ]
  119. !
  120. outerContext
  121. ^ outerContext
  122. !
  123. outerContext: anAIContext
  124. outerContext := anAIContext.
  125. outerContext ifNotNil: [ :context |
  126. context innerContext: self ]
  127. !
  128. selector
  129. ^ selector
  130. !
  131. selector: aString
  132. selector := aString
  133. !
  134. sendIndexAt: aString
  135. ^ self sendIndexes at: aString ifAbsent: [ 0 ]
  136. !
  137. sendIndexes
  138. ^ sendIndexes ifNil: [ Dictionary new ]
  139. !
  140. sendIndexes: aDictionary
  141. sendIndexes := aDictionary
  142. ! !
  143. !AIContext methodsFor: 'evaluating'!
  144. evaluateNode: aNode
  145. ^ ASTInterpreter new
  146. context: self;
  147. node: aNode nextChild;
  148. proceed;
  149. result
  150. ! !
  151. !AIContext methodsFor: 'factory'!
  152. newBlockContext
  153. ^ self class new
  154. outerContext: self;
  155. yourself
  156. ! !
  157. !AIContext methodsFor: 'initialization'!
  158. initializeAST
  159. ast := self method ast.
  160. (SemanticAnalyzer on: self method methodClass)
  161. visit: ast
  162. !
  163. initializeFromMethodContext: aMethodContext
  164. self
  165. evaluatedSelector: aMethodContext evaluatedSelector;
  166. index: aMethodContext index;
  167. sendIndexes: aMethodContext sendIndexes;
  168. receiver: aMethodContext receiver;
  169. selector: aMethodContext selector.
  170. aMethodContext outerContext ifNotNil: [ :outer |
  171. "If the method context is nil, the block was defined in JS, so ignore it"
  172. outer methodContext ifNotNil: [
  173. self outerContext: (self class fromMethodContext: aMethodContext outerContext) ].
  174. aMethodContext locals keysAndValuesDo: [ :key :value |
  175. self locals at: key put: value ] ]
  176. !
  177. initializeInterpreter
  178. interpreter := ASTInterpreter new
  179. context: self;
  180. yourself.
  181. self innerContext ifNotNil: [
  182. self setupInterpreter: interpreter ]
  183. !
  184. initializeLocals
  185. locals := Dictionary new.
  186. locals at: 'thisContext' put: self.
  187. ! !
  188. !AIContext methodsFor: 'interpreting'!
  189. arguments
  190. ^ self ast arguments collect: [ :each |
  191. self localAt: each ]
  192. !
  193. ast
  194. self isBlockContext ifTrue: [
  195. ^ self outerContext ifNotNil: [ :context | context ast ] ].
  196. ast ifNil: [ self initializeAST ].
  197. ^ ast
  198. !
  199. interpreter
  200. interpreter ifNil: [ self initializeInterpreter ].
  201. ^ interpreter
  202. !
  203. interpreter: anInterpreter
  204. interpreter := anInterpreter
  205. !
  206. receiver
  207. ^ self localAt: 'self'
  208. !
  209. receiver: anObject
  210. self localAt: 'self' put: anObject
  211. !
  212. setupInterpreter: anInterpreter
  213. | currentNode |
  214. "Retrieve the current node"
  215. currentNode := ASTPCNodeVisitor new
  216. selector: self evaluatedSelector;
  217. context: self;
  218. visit: self ast;
  219. currentNode.
  220. anInterpreter node: currentNode.
  221. "Push the send args and receiver to the interpreter stack"
  222. self innerContext arguments reversed do: [ :each |
  223. anInterpreter push: each ].
  224. anInterpreter push: (self innerContext receiver)
  225. ! !
  226. !AIContext class methodsFor: 'instance creation'!
  227. fromMethodContext: aMethodContext
  228. ^ self new
  229. initializeFromMethodContext: aMethodContext;
  230. yourself
  231. ! !
  232. Object subclass: #ASTDebugger
  233. instanceVariableNames: 'interpreter context'
  234. package: 'Compiler-Interpreter'!
  235. !ASTDebugger commentStamp!
  236. I am a stepping debugger interface for Amber code.
  237. I internally use an instance of `ASTInterpreter` to actually step through node and interpret them.
  238. My instances are created from an `AIContext` with `ASTDebugger class >> context:`.
  239. They hold an `AIContext` instance internally, recursive copy of the `MethodContext`.
  240. ## API
  241. Use the methods of the `'stepping'` protocol to do stepping.!
  242. !ASTDebugger methodsFor: 'accessing'!
  243. context
  244. ^ context
  245. !
  246. context: aContext
  247. context := aContext
  248. !
  249. interpreter
  250. ^ self context interpreter
  251. !
  252. method
  253. ^ self context method
  254. !
  255. nextNode
  256. ^ self interpreter nextNode
  257. ! !
  258. !ASTDebugger methodsFor: 'stepping'!
  259. proceed
  260. self shouldBeImplemented
  261. !
  262. restart
  263. self interpreter restart
  264. !
  265. skip
  266. self interpreter skip
  267. !
  268. stepInto
  269. self shouldBeImplemented
  270. !
  271. stepOver
  272. self flushOuterContexts.
  273. self interpreter stepOver
  274. ! !
  275. !ASTDebugger methodsFor: 'testing'!
  276. atEnd
  277. ^ self interpreter atEnd
  278. ! !
  279. !ASTDebugger class methodsFor: 'instance creation'!
  280. context: aContext
  281. ^ self new
  282. context: aContext;
  283. yourself
  284. ! !
  285. NodeVisitor subclass: #ASTInterpreter
  286. instanceVariableNames: 'node context stack returnValue returned'
  287. package: 'Compiler-Interpreter'!
  288. !ASTInterpreter commentStamp!
  289. I visit an AST, interpreting (evaluating) nodes one after the other, using a small stack machine.
  290. ## API
  291. While my instances should be used from within an `ASTDebugger`, which provides a more high level interface,
  292. you can use methods from the `interpreting` protocol:
  293. - `#step` evaluates the current `node` only
  294. - `#stepOver` evaluates the AST from the current `node` up to the next stepping node (most likely the next send node)
  295. - `#proceed` evaluates eagerly the AST
  296. - `#restart` select the first node of the AST
  297. - `#skip` skips the current node, moving to the next one if any!
  298. !ASTInterpreter methodsFor: 'accessing'!
  299. context
  300. ^ context
  301. !
  302. context: aContext
  303. context := aContext
  304. !
  305. node
  306. "Answer the next node, ie the node to be evaluated in the next step"
  307. ^ node
  308. !
  309. node: aNode
  310. node := aNode
  311. !
  312. result
  313. ^ self hasReturned
  314. ifTrue: [ self returnValue ]
  315. ifFalse: [ self context receiver ]
  316. !
  317. returnValue
  318. ^ returnValue
  319. !
  320. returnValue: anObject
  321. returnValue := anObject
  322. !
  323. stack
  324. ^ stack ifNil: [ stack := OrderedCollection new ]
  325. ! !
  326. !ASTInterpreter methodsFor: 'interpreting'!
  327. interpret
  328. "Interpret the next node to be evaluated"
  329. self visit: self node
  330. !
  331. interpret: aNode
  332. self node: aNode.
  333. self interpret
  334. !
  335. next
  336. self node: self node nextNode
  337. !
  338. proceed
  339. "Eagerly evaluate the ast"
  340. [ self atEnd ]
  341. whileFalse: [ self step ]
  342. !
  343. restart
  344. self node: self context ast nextChild
  345. !
  346. setNonLocalReturnFromContext: aContext
  347. aContext interpreter hasReturned ifTrue: [
  348. returned := true.
  349. self returnValue: aContext interpreter returnValue ]
  350. !
  351. skip
  352. self next
  353. !
  354. step
  355. self
  356. interpret;
  357. next
  358. !
  359. stepOver
  360. self step.
  361. [ self node isSteppingNode ] whileFalse: [
  362. self step ]
  363. ! !
  364. !ASTInterpreter methodsFor: 'private'!
  365. assign: aNode to: anObject
  366. aNode binding isInstanceVar
  367. ifTrue: [ self context receiver instVarAt: aNode value put: anObject ]
  368. ifFalse: [ self context localAt: aNode value put: anObject ]
  369. !
  370. eval: aString
  371. "Evaluate aString as JS source inside an JS function.
  372. aString is not sandboxed."
  373. | source function |
  374. source := String streamContents: [ :str |
  375. str nextPutAll: '(function('.
  376. self context locals keys
  377. do: [ :each | str nextPutAll: each ]
  378. separatedBy: [ str nextPutAll: ',' ].
  379. str
  380. nextPutAll: '){ return (function() {';
  381. nextPutAll: aString;
  382. nextPutAll: '})() })' ].
  383. function := Compiler new eval: source.
  384. ^ function valueWithPossibleArguments: self context locals values
  385. !
  386. messageFromSendNode: aSendNode arguments: aCollection
  387. ^ Message new
  388. selector: aSendNode selector;
  389. arguments: aCollection;
  390. yourself
  391. !
  392. messageNotUnderstood: aMessage receiver: anObject
  393. MessageNotUnderstood new
  394. meesage: aMessage;
  395. receiver: anObject;
  396. signal
  397. !
  398. sendMessage: aMessage to: anObject superSend: aBoolean
  399. | method |
  400. aBoolean ifFalse: [ ^ aMessage sendTo: anObject ].
  401. anObject class superclass ifNil: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
  402. method := anObject class superclass methodDictionary
  403. at: aMessage selector
  404. ifAbsent: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
  405. ^ method sendTo: anObject arguments: aMessage arguments
  406. ! !
  407. !ASTInterpreter methodsFor: 'stack'!
  408. peek
  409. "Peek the top object of the context stack"
  410. self stack ifEmpty: [ ^ nil ].
  411. ^ self stack last
  412. !
  413. pop
  414. "Pop an object from the context stack"
  415. | peekedValue |
  416. peekedValue := self peek.
  417. self stack removeLast.
  418. ^ peekedValue
  419. !
  420. push: anObject
  421. "Push an object to the context stack"
  422. ^ self stack add: anObject
  423. ! !
  424. !ASTInterpreter methodsFor: 'testing'!
  425. atEnd
  426. ^ self hasReturned or: [ self node isNil ]
  427. !
  428. hasReturned
  429. ^ returned ifNil: [ false ]
  430. ! !
  431. !ASTInterpreter methodsFor: 'visiting'!
  432. visit: aNode
  433. self hasReturned ifFalse: [ super visit: aNode ]
  434. !
  435. visitAssignmentNode: aNode
  436. | poppedValue |
  437. poppedValue := self pop.
  438. "Pop the left side of the assignment.
  439. It already has been visited, and we don't need its value."
  440. self pop.
  441. self push: poppedValue.
  442. self assign: aNode left to: poppedValue
  443. !
  444. visitBlockNode: aNode
  445. "Do not evaluate the block node.
  446. Instead, put all instructions into a block that we push to the stack for later evaluation"
  447. | block |
  448. block := AIBlockClosure forContext: self context node: aNode.
  449. self push: block
  450. !
  451. visitDynamicArrayNode: aNode
  452. | array |
  453. array := #().
  454. aNode nodes do: [ :each |
  455. array addFirst: self pop ].
  456. self push: array
  457. !
  458. visitDynamicDictionaryNode: aNode
  459. | keyValueList |
  460. keyValueList := OrderedCollection new.
  461. aNode nodes do: [ :each |
  462. keyValueList add: self pop ].
  463. self push: (HashedCollection newFromPairs: keyValueList reversed)
  464. !
  465. visitJSStatementNode: aNode
  466. returned := true.
  467. self returnValue: (self eval: aNode source)
  468. !
  469. visitNode: aNode
  470. "Do nothing by default. Especially, do not visit children recursively."
  471. !
  472. visitReturnNode: aNode
  473. returned := true.
  474. self returnValue: self pop
  475. !
  476. visitSendNode: aNode
  477. | receiver args message result |
  478. args := aNode arguments collect: [ :each | self pop ].
  479. receiver := self pop.
  480. message := self
  481. messageFromSendNode: aNode
  482. arguments: args reversed.
  483. result := self sendMessage: message to: receiver superSend: aNode superSend.
  484. "For cascade sends, push the reciever if the send is not the last one"
  485. (aNode isCascadeSendNode and: [ aNode isLastChild not ])
  486. ifTrue: [ self push: receiver ]
  487. ifFalse: [ self push: result ]
  488. !
  489. visitValueNode: aNode
  490. self push: aNode value
  491. !
  492. visitVariableNode: aNode
  493. aNode binding isUnknownVar ifTrue: [
  494. ^ self push: (PlatformInterface globals at: aNode value ifAbsent: [ self error: 'Unknown variable' ]) ].
  495. self push: (aNode binding isInstanceVar
  496. ifTrue: [ self context receiver instVarAt: aNode value ]
  497. ifFalse: [ self context
  498. localAt: aNode value
  499. ifAbsent: [
  500. aNode value isCapitalized
  501. ifTrue: [
  502. Smalltalk globals
  503. at: aNode value
  504. ifAbsent: [ PlatformInterface globals at: aNode value ] ] ] ])
  505. ! !
  506. Error subclass: #ASTInterpreterError
  507. instanceVariableNames: ''
  508. package: 'Compiler-Interpreter'!
  509. !ASTInterpreterError commentStamp!
  510. I get signaled when an AST interpreter is unable to interpret a node.!
  511. NodeVisitor subclass: #ASTPCNodeVisitor
  512. instanceVariableNames: 'context index selector currentNode'
  513. package: 'Compiler-Interpreter'!
  514. !ASTPCNodeVisitor commentStamp!
  515. I visit an AST until I get to the current node for the `context` and answer it.
  516. ## API
  517. My instances must be filled with a context object using `#context:`.
  518. After visiting the AST the current node is answered by `#currentNode`!
  519. !ASTPCNodeVisitor methodsFor: 'accessing'!
  520. context
  521. ^ context
  522. !
  523. context: aContext
  524. context := aContext
  525. !
  526. currentNode
  527. ^ currentNode
  528. !
  529. increaseIndex
  530. index := self index + 1
  531. !
  532. index
  533. ^ index ifNil: [ index := 0 ]
  534. !
  535. selector
  536. ^ selector
  537. !
  538. selector: aString
  539. selector := aString
  540. ! !
  541. !ASTPCNodeVisitor methodsFor: 'visiting'!
  542. visitJSStatementNode: aNode
  543. "If a JSStatementNode is encountered, it always is the current node.
  544. Stop visiting the AST there"
  545. currentNode := aNode
  546. !
  547. visitSendNode: aNode
  548. | sendIndex |
  549. sendIndex := self context sendIndexAt: self selector.
  550. super visitSendNode: aNode.
  551. self selector = aNode selector ifTrue: [
  552. self index < sendIndex ifFalse: [
  553. self index > sendIndex ifFalse: [ currentNode := aNode ] ].
  554. self increaseIndex ]
  555. ! !
  556. !AssignmentNode methodsFor: '*Compiler-Interpreter'!
  557. isSteppingNode
  558. ^ true
  559. ! !
  560. !BlockNode methodsFor: '*Compiler-Interpreter'!
  561. isSteppingNode
  562. ^ true
  563. ! !
  564. !DynamicArrayNode methodsFor: '*Compiler-Interpreter'!
  565. isSteppingNode
  566. ^ true
  567. ! !
  568. !DynamicDictionaryNode methodsFor: '*Compiler-Interpreter'!
  569. isSteppingNode
  570. ^ true
  571. ! !
  572. !JSStatementNode methodsFor: '*Compiler-Interpreter'!
  573. isSteppingNode
  574. ^ true
  575. ! !
  576. !Node methodsFor: '*Compiler-Interpreter'!
  577. isSteppingNode
  578. ^ false
  579. ! !
  580. !SendNode methodsFor: '*Compiler-Interpreter'!
  581. isSteppingNode
  582. ^ true
  583. ! !