1
0

Compiler-Interpreter.st 16 KB

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