1
0

Compiler-Interpreter.st 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829
  1. Smalltalk current 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 innerContext: self
  126. !
  127. selector
  128. ^ selector
  129. !
  130. selector: aString
  131. selector := aString
  132. !
  133. sendIndexAt: aString
  134. ^ self sendIndexes at: aString ifAbsent: [ 0 ]
  135. !
  136. sendIndexes
  137. ^ sendIndexes ifNil: [ Dictionary new ]
  138. !
  139. sendIndexes: aDictionary
  140. sendIndexes := aDictionary
  141. ! !
  142. !AIContext methodsFor: 'factory'!
  143. newBlockContext
  144. ^ self class new
  145. outerContext: self;
  146. yourself
  147. ! !
  148. !AIContext methodsFor: 'initialization'!
  149. initializeAST
  150. ast := self method ast.
  151. (SemanticAnalyzer on: self method methodClass)
  152. visit: ast
  153. !
  154. initializeFromMethodContext: aMethodContext
  155. self
  156. evaluatedSelector: aMethodContext evaluatedSelector;
  157. index: aMethodContext index;
  158. sendIndexes: aMethodContext sendIndexes;
  159. receiver: aMethodContext receiver;
  160. selector: aMethodContext selector.
  161. aMethodContext outerContext ifNotNil: [ :outer |
  162. "If the method context is nil, the block was defined in JS, so ignore it"
  163. outer methodContext ifNotNil: [
  164. self outerContext: (self class fromMethodContext: aMethodContext outerContext) ].
  165. aMethodContext locals keysAndValuesDo: [ :key :value |
  166. self locals at: key put: value ] ]
  167. !
  168. initializeInterpreter
  169. interpreter := ASTInterpreter new
  170. context: self;
  171. yourself.
  172. self innerContext ifNotNil: [
  173. self setupInterpreter: interpreter ]
  174. !
  175. initializeLocals
  176. locals := Dictionary new.
  177. locals at: 'thisContext' put: self.
  178. ! !
  179. !AIContext methodsFor: 'interpreting'!
  180. arguments
  181. ^ self ast arguments collect: [ :each |
  182. self localAt: each ]
  183. !
  184. ast
  185. self isBlockContext ifTrue: [
  186. ^ self outerContext ifNotNil: [ :context | context ast ] ].
  187. ast ifNil: [ self initializeAST ].
  188. ^ ast
  189. !
  190. interpreter
  191. interpreter ifNil: [ self initializeInterpreter ].
  192. ^ interpreter
  193. !
  194. interpreter: anInterpreter
  195. interpreter := anInterpreter
  196. !
  197. receiver
  198. ^ self localAt: 'self'
  199. !
  200. receiver: anObject
  201. self localAt: 'self' put: anObject
  202. !
  203. setupInterpreter: anInterpreter
  204. | currentNode |
  205. "Retrieve the current node"
  206. currentNode := ASTPCNodeVisitor new
  207. selector: self evaluatedSelector;
  208. context: self;
  209. visit: self ast;
  210. currentNode.
  211. anInterpreter node: currentNode.
  212. "Push the send args and receiver to the interpreter stack"
  213. self innerContext arguments reversed do: [ :each |
  214. anInterpreter push: each ].
  215. anInterpreter push: (self innerContext receiver)
  216. ! !
  217. !AIContext class methodsFor: 'instance creation'!
  218. fromMethodContext: aMethodContext
  219. ^ self new
  220. initializeFromMethodContext: aMethodContext;
  221. yourself
  222. ! !
  223. Object subclass: #ASTDebugger
  224. instanceVariableNames: 'interpreter context'
  225. package: 'Compiler-Interpreter'!
  226. !ASTDebugger commentStamp!
  227. I am a stepping debugger interface for Amber code.
  228. I internally use an instance of `ASTInterpreter` to actually step through node and interpret them.
  229. My instances are created from an `AIContext` with `ASTDebugger class >> context:`.
  230. They hold an `AIContext` instance internally, recursive copy of the `MethodContext`.
  231. ## API
  232. Use the methods of the `'stepping'` protocol to do stepping.!
  233. !ASTDebugger methodsFor: 'accessing'!
  234. context
  235. ^ context
  236. !
  237. context: aContext
  238. context := aContext
  239. !
  240. interpreter
  241. ^ interpreter ifNil: [ interpreter := self defaultInterpreterClass new ]
  242. !
  243. interpreter: anInterpreter
  244. interpreter := anInterpreter
  245. !
  246. method
  247. ^ self context method
  248. !
  249. nextNode
  250. ^ self interpreter nextNode
  251. ! !
  252. !ASTDebugger methodsFor: 'defaults'!
  253. defaultInterpreterClass
  254. ^ ASTInterpreter
  255. ! !
  256. !ASTDebugger methodsFor: 'initialization'!
  257. buildAST
  258. "Build the AST tree from the method source code.
  259. The AST is annotated with a SemanticAnalyzer,
  260. to know the semantics and bindings of each node needed for later debugging"
  261. | ast |
  262. ast := Smalltalk current parse: self method source.
  263. (SemanticAnalyzer on: self context receiver class)
  264. visit: ast.
  265. ^ ast
  266. !
  267. initializeInterpreter
  268. | ast next |
  269. ast := self buildAST.
  270. next := ASTPCNodeVisitor new
  271. context: self context;
  272. visit: ast;
  273. currentNode.
  274. self interpreter node: next
  275. !
  276. initializeWithContext: aContext
  277. "TODO: do we need to handle block contexts?"
  278. self context: aContext.
  279. self initializeInterpreter
  280. ! !
  281. !ASTDebugger methodsFor: 'stepping'!
  282. proceed
  283. self shouldBeImplemented
  284. !
  285. restart
  286. self interpreter restart
  287. !
  288. skip
  289. self interpreter skip
  290. !
  291. stepInto
  292. self shouldBeImplemented
  293. !
  294. stepOver
  295. self interpreter stepOver
  296. ! !
  297. !ASTDebugger methodsFor: 'testing'!
  298. atEnd
  299. ^ self interpreter atEnd
  300. ! !
  301. !ASTDebugger class methodsFor: 'instance creation'!
  302. context: aContext
  303. ^ self new
  304. initializeWithContext: aContext;
  305. yourself
  306. ! !
  307. NodeVisitor subclass: #ASTInterpreter
  308. instanceVariableNames: 'node context stack returnValue returned'
  309. package: 'Compiler-Interpreter'!
  310. !ASTInterpreter commentStamp!
  311. I visit an AST, interpreting (evaluating) nodes one after the other, using a small stack machine.
  312. ## API
  313. While my instances should be used from within an `ASTDebugger`, which provides a more high level interface,
  314. you can use methods from the `interpreting` protocol:
  315. - `#step` evaluates the current `node` only
  316. - `#stepOver` evaluates the AST from the current `node` up to the next stepping node (most likely the next send node)
  317. - `#proceed` evaluates eagerly the AST
  318. - `#restart` select the first node of the AST
  319. - `#skip` skips the current node, moving to the next one if any!
  320. !ASTInterpreter methodsFor: 'accessing'!
  321. context
  322. ^ context
  323. !
  324. context: aContext
  325. context := aContext
  326. !
  327. node
  328. "Answer the next node, ie the node to be evaluated in the next step"
  329. ^ node
  330. !
  331. node: aNode
  332. node := aNode
  333. !
  334. result
  335. ^ self hasReturned
  336. ifTrue: [ self returnValue ]
  337. ifFalse: [ self context receiver ]
  338. !
  339. returnValue
  340. ^ returnValue
  341. !
  342. returnValue: anObject
  343. returnValue := anObject
  344. !
  345. stack
  346. ^ stack ifNil: [ stack := OrderedCollection new ]
  347. ! !
  348. !ASTInterpreter methodsFor: 'interpreting'!
  349. interpret
  350. "Interpret the next node to be evaluated"
  351. self visit: self node
  352. !
  353. interpret: aNode
  354. self node: aNode.
  355. self interpret
  356. !
  357. next
  358. self node: self node nextNode
  359. !
  360. proceed
  361. "Eagerly evaluate the ast"
  362. [ self atEnd ]
  363. whileFalse: [ self step ]
  364. !
  365. restart
  366. self node: self context ast nextChild
  367. !
  368. setNonLocalReturnFromContext: aContext
  369. aContext interpreter hasReturned ifTrue: [
  370. returned := true.
  371. self returnValue: aContext interpreter returnValue ]
  372. !
  373. skip
  374. self next
  375. !
  376. step
  377. self
  378. interpret;
  379. next
  380. !
  381. stepOver
  382. self step.
  383. [ self node isSteppingNode ] whileFalse: [
  384. self step ]
  385. ! !
  386. !ASTInterpreter methodsFor: 'private'!
  387. assign: aNode to: anObject
  388. aNode binding isInstanceVar
  389. ifTrue: [ self context receiver instVarAt: aNode value put: anObject ]
  390. ifFalse: [ self context localAt: aNode value put: anObject ]
  391. !
  392. eval: aString
  393. "Evaluate aString as JS source inside an JS function.
  394. aString is not sandboxed."
  395. | source function |
  396. source := String streamContents: [ :str |
  397. str nextPutAll: '(function('.
  398. self context locals keys
  399. do: [ :each | str nextPutAll: each ]
  400. separatedBy: [ str nextPutAll: ',' ].
  401. str
  402. nextPutAll: '){ return (function() {';
  403. nextPutAll: aString;
  404. nextPutAll: '})() })' ].
  405. function := Compiler new eval: source.
  406. ^ function valueWithPossibleArguments: self context locals values
  407. !
  408. messageFromSendNode: aSendNode arguments: aCollection
  409. ^ Message new
  410. selector: aSendNode selector;
  411. arguments: aCollection;
  412. yourself
  413. !
  414. messageNotUnderstood: aMessage receiver: anObject
  415. MessageNotUnderstood new
  416. meesage: aMessage;
  417. receiver: anObject;
  418. signal
  419. !
  420. sendMessage: aMessage to: anObject superSend: aBoolean
  421. | method |
  422. aBoolean ifFalse: [ ^ aMessage sendTo: anObject ].
  423. anObject class superclass ifNil: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
  424. method := anObject class superclass methodDictionary
  425. at: aMessage selector
  426. ifAbsent: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
  427. ^ method sendTo: anObject arguments: aMessage arguments
  428. ! !
  429. !ASTInterpreter methodsFor: 'stack'!
  430. peek
  431. "Peek the top object of the context stack"
  432. self stack ifEmpty: [ ^ nil ].
  433. ^ self stack last
  434. !
  435. pop
  436. "Pop an object from the context stack"
  437. | peekedValue |
  438. peekedValue := self peek.
  439. self stack removeLast.
  440. ^ peekedValue
  441. !
  442. push: anObject
  443. "Push an object to the context stack"
  444. ^ self stack add: anObject
  445. ! !
  446. !ASTInterpreter methodsFor: 'testing'!
  447. atEnd
  448. ^ self hasReturned or: [ self node isNil ]
  449. !
  450. hasReturned
  451. ^ returned ifNil: [ false ]
  452. ! !
  453. !ASTInterpreter methodsFor: 'visiting'!
  454. visit: aNode
  455. self hasReturned ifFalse: [ super visit: aNode ]
  456. !
  457. visitAssignmentNode: aNode
  458. | poppedValue |
  459. poppedValue := self pop.
  460. "Pop the left side of the assignment.
  461. It already has been visited, and we don't need its value."
  462. self pop.
  463. self push: poppedValue.
  464. self assign: aNode left to: poppedValue
  465. !
  466. visitBlockNode: aNode
  467. "Do not evaluate the block node.
  468. Instead, put all instructions into a block that we push to the stack for later evaluation"
  469. | block |
  470. block := AIBlockClosure forContext: self context node: aNode.
  471. self push: block
  472. !
  473. visitDynamicArrayNode: aNode
  474. | array |
  475. array := #().
  476. aNode nodes do: [ :each |
  477. array addFirst: self pop ].
  478. self push: array
  479. !
  480. visitDynamicDictionaryNode: aNode
  481. | associations hashedCollection |
  482. associations := OrderedCollection new.
  483. hashedCollection := HashedCollection new.
  484. aNode nodes do: [ :each |
  485. associations add: self pop ].
  486. associations reversed do: [ :each |
  487. hashedCollection add: each ].
  488. self push: hashedCollection
  489. !
  490. visitJSStatementNode: aNode
  491. returned := true.
  492. self returnValue: (self eval: aNode source)
  493. !
  494. visitNode: aNode
  495. "Do nothing by default. Especially, do not visit children recursively."
  496. !
  497. visitReturnNode: aNode
  498. returned := true.
  499. self returnValue: self pop
  500. !
  501. visitSendNode: aNode
  502. | receiver args message result |
  503. args := aNode arguments collect: [ :each | self pop ].
  504. receiver := self pop.
  505. message := self
  506. messageFromSendNode: aNode
  507. arguments: args reversed.
  508. result := self sendMessage: message to: receiver superSend: aNode superSend.
  509. "For cascade sends, push the reciever if the send is not the last one"
  510. (aNode isCascadeSendNode and: [ aNode isLastChild not ])
  511. ifTrue: [ self push: receiver ]
  512. ifFalse: [ self push: result ]
  513. !
  514. visitValueNode: aNode
  515. self push: aNode value
  516. !
  517. visitVariableNode: aNode
  518. aNode binding isUnknownVar ifTrue: [
  519. ^ self push: (PlatformInterface globals at: aNode value ifAbsent: [ self error: 'Unknown variable' ]) ].
  520. self push: (aNode binding isInstanceVar
  521. ifTrue: [ self context receiver instVarAt: aNode value ]
  522. ifFalse: [ self context
  523. localAt: aNode value
  524. ifAbsent: [
  525. aNode value isCapitalized
  526. ifTrue: [
  527. Smalltalk current
  528. at: aNode value
  529. ifAbsent: [ PlatformInterface globals at: aNode value ] ] ] ])
  530. ! !
  531. Error subclass: #ASTInterpreterError
  532. instanceVariableNames: ''
  533. package: 'Compiler-Interpreter'!
  534. !ASTInterpreterError commentStamp!
  535. I get signaled when an AST interpreter is unable to interpret a node.!
  536. NodeVisitor subclass: #ASTPCNodeVisitor
  537. instanceVariableNames: 'context index selector currentNode'
  538. package: 'Compiler-Interpreter'!
  539. !ASTPCNodeVisitor commentStamp!
  540. I visit an AST until I get to the current node for the `context` and answer it.
  541. ## API
  542. My instances must be filled with a context object using `#context:`.
  543. After visiting the AST the current node is answered by `#currentNode`!
  544. !ASTPCNodeVisitor methodsFor: 'accessing'!
  545. context
  546. ^ context
  547. !
  548. context: aContext
  549. context := aContext
  550. !
  551. currentNode
  552. ^ currentNode
  553. !
  554. increaseIndex
  555. index := self index + 1
  556. !
  557. index
  558. ^ index ifNil: [ index := 0 ]
  559. !
  560. selector
  561. ^ selector
  562. !
  563. selector: aString
  564. selector := aString
  565. ! !
  566. !ASTPCNodeVisitor methodsFor: 'visiting'!
  567. visitJSStatementNode: aNode
  568. "If a JSStatementNode is encountered, it always is the current node.
  569. Stop visiting the AST there"
  570. currentNode := aNode
  571. !
  572. visitSendNode: aNode
  573. | sendIndex |
  574. sendIndex := self context sendIndexAt: self selector.
  575. super visitSendNode: aNode.
  576. self selector = aNode selector ifTrue: [
  577. self index < sendIndex ifFalse: [
  578. self index > sendIndex ifFalse: [ currentNode := aNode ] ].
  579. self increaseIndex ]
  580. ! !
  581. !Node methodsFor: '*Compiler-Interpreter'!
  582. isSteppingNode
  583. ^ false
  584. ! !
  585. !AssignmentNode methodsFor: '*Compiler-Interpreter'!
  586. isSteppingNode
  587. ^ true
  588. ! !
  589. !BlockNode methodsFor: '*Compiler-Interpreter'!
  590. isSteppingNode
  591. ^ true
  592. ! !
  593. !DynamicArrayNode methodsFor: '*Compiler-Interpreter'!
  594. isSteppingNode
  595. ^ true
  596. ! !
  597. !DynamicDictionaryNode methodsFor: '*Compiler-Interpreter'!
  598. isSteppingNode
  599. ^ true
  600. ! !
  601. !JSStatementNode methodsFor: '*Compiler-Interpreter'!
  602. isSteppingNode
  603. ^ true
  604. ! !
  605. !SendNode methodsFor: '*Compiler-Interpreter'!
  606. isSteppingNode
  607. ^ true
  608. ! !