1
0

Compiler-Interpreter.st 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734
  1. Smalltalk current createPackage: 'Compiler-Interpreter'!
  2. NodeVisitor subclass: #AIContext
  3. instanceVariableNames: 'methodContext outerContext pc locals method'
  4. package: 'Compiler-Interpreter'!
  5. !AIContext commentStamp!
  6. I am like a `MethodContext`, used by the `ASTInterpreter`.
  7. Unlike a `MethodContext`, my instances are not read-only.
  8. When debugging, my instances are created by copying the current `MethodContext` (thisContext)!
  9. !AIContext methodsFor: 'accessing'!
  10. home
  11. ^ self isBlockContext
  12. ifTrue: [ self outerContext methodContext ]
  13. ifFalse: [ self ]
  14. !
  15. localAt: aString
  16. ^ self locals at: aString ifAbsent: [ nil ]
  17. !
  18. localAt: aString put: anObject
  19. self locals at: aString put: anObject
  20. !
  21. locals
  22. locals ifNil: [ self initializeLocals ].
  23. ^ locals
  24. !
  25. method
  26. ^ method
  27. !
  28. method: aCompiledMethod
  29. method := aCompiledMethod
  30. !
  31. outerContext
  32. ^ outerContext
  33. !
  34. outerContext: anAIContext
  35. outerContext := anAIContext
  36. !
  37. pc
  38. ^ pc ifNil: [ pc := 0 ]
  39. !
  40. pc: anInteger
  41. pc := anInteger
  42. !
  43. receiver
  44. ^ self localAt: 'self'
  45. !
  46. receiver: anObject
  47. self localAt: 'self' put: anObject
  48. !
  49. selector
  50. ^ self method
  51. ifNotNil: [ self method selector ]
  52. ! !
  53. !AIContext methodsFor: 'converting'!
  54. asString
  55. ^ methodContext asString
  56. ! !
  57. !AIContext methodsFor: 'initialization'!
  58. initializeFromMethodContext: aMethodContext
  59. methodContext := aMethodContext.
  60. self pc: aMethodContext pc.
  61. self receiver: aMethodContext receiver.
  62. self method: aMethodContext method.
  63. aMethodContext outerContext ifNotNil: [ :outer |
  64. "If the method context is nil, the block was defined in JS, so ignore it"
  65. outer methodContext ifNotNil: [
  66. self outerContext: (self class fromMethodContext: aMethodContext outerContext) ].
  67. aMethodContext locals keysAndValuesDo: [ :key :value |
  68. self locals at: key put: value ] ]
  69. !
  70. initializeLocals
  71. locals := Dictionary new.
  72. locals at: 'thisContext' put: self.
  73. ! !
  74. !AIContext methodsFor: 'testing'!
  75. isBlockContext
  76. ^ methodContext isBlockContext
  77. ! !
  78. !AIContext class methodsFor: 'instance creation'!
  79. fromMethodContext: aMethodContext
  80. ^ self new
  81. initializeFromMethodContext: aMethodContext;
  82. yourself
  83. ! !
  84. Object subclass: #ASTDebugger
  85. instanceVariableNames: 'interpreter context'
  86. package: 'Compiler-Interpreter'!
  87. !ASTDebugger commentStamp!
  88. I am a stepping debugger interface for Amber code.
  89. I internally use an instance of `ASTSteppingInterpreter` to actually step through node and interpret them.
  90. My instances are created from a `MethodContext` with `ASTDebugger class >> context:`.
  91. They hold an `AIContext` instance internally, recursive copy of the `MethodContext`.
  92. ## API
  93. Use the methods of the `'stepping'` protocol to do stepping.!
  94. !ASTDebugger methodsFor: 'accessing'!
  95. context
  96. ^ context
  97. !
  98. context: aContext
  99. context := aContext
  100. !
  101. interpreter
  102. ^ interpreter ifNil: [ interpreter := self defaultInterpreterClass new ]
  103. !
  104. interpreter: anInterpreter
  105. interpreter := anInterpreter
  106. !
  107. method
  108. ^ self context method
  109. !
  110. nextNode
  111. ^ self interpreter nextNode
  112. ! !
  113. !ASTDebugger methodsFor: 'defaults'!
  114. defaultInterpreterClass
  115. ^ ASTSteppingInterpreter
  116. ! !
  117. !ASTDebugger methodsFor: 'initialization'!
  118. buildAST
  119. "Build the AST tree from the method source code.
  120. The AST is annotated with a SemanticAnalyzer,
  121. to know the semantics and bindings of each node needed for later debugging"
  122. | ast |
  123. ast := Smalltalk current parse: self method source.
  124. (SemanticAnalyzer on: self context receiver class)
  125. visit: ast.
  126. ^ ast
  127. !
  128. initializeInterpreter
  129. | ast next |
  130. ast := self buildAST.
  131. next := ASTPCNodeVisitor new
  132. context: self context;
  133. visit: ast;
  134. currentNode.
  135. self interpreter interpret: next
  136. !
  137. initializeWithContext: aContext
  138. "TODO: do we need to handle block contexts?"
  139. self context: aContext.
  140. self initializeInterpreter
  141. ! !
  142. !ASTDebugger methodsFor: 'stepping'!
  143. proceed
  144. self shouldBeImplemented
  145. !
  146. restart
  147. self shouldBeImplemented
  148. !
  149. step
  150. "The ASTSteppingInterpreter stops at each node interpretation.
  151. One step will interpret nodes until:
  152. - we get at the end
  153. - the next node is a stepping node (send, assignment, etc.)"
  154. [ (self interpreter nextNode notNil and: [ self interpreter nextNode stopOnStepping ])
  155. or: [ self interpreter atEnd not ] ]
  156. whileFalse: [
  157. self interpreter step.
  158. self step ]
  159. !
  160. stepInto
  161. self shouldBeImplemented
  162. !
  163. stepOver
  164. self step
  165. ! !
  166. !ASTDebugger methodsFor: 'testing'!
  167. atEnd
  168. ^ self interpreter atEnd
  169. ! !
  170. !ASTDebugger class methodsFor: 'instance creation'!
  171. context: aContext
  172. ^ self new
  173. initializeWithContext: aContext;
  174. yourself
  175. ! !
  176. Object subclass: #ASTInterpreter
  177. instanceVariableNames: 'currentNode context shouldReturn result'
  178. package: 'Compiler-Interpreter'!
  179. !ASTInterpreter commentStamp!
  180. I am like a `NodeVisitor`, interpreting nodes one after each other.
  181. I am built using Continuation Passing Style for stepping purposes.
  182. ## Usage example:
  183. | ast interpreter |
  184. ast := Smalltalk current parse: 'foo 1+2+4'.
  185. (SemanticAnalyzer on: Object) visit: ast.
  186. ASTInterpreter new
  187. interpret: ast nodes first;
  188. result "Answers 7"!
  189. !ASTInterpreter methodsFor: 'accessing'!
  190. context
  191. ^ context ifNil: [ context := AIContext new ]
  192. !
  193. context: anAIContext
  194. context := anAIContext
  195. !
  196. currentNode
  197. ^ currentNode
  198. !
  199. result
  200. ^ result
  201. ! !
  202. !ASTInterpreter methodsFor: 'initialization'!
  203. initialize
  204. super initialize.
  205. shouldReturn := false
  206. ! !
  207. !ASTInterpreter methodsFor: 'interpreting'!
  208. interpret: aNode
  209. shouldReturn := false.
  210. self interpret: aNode continue: [ :value |
  211. result := value ]
  212. !
  213. interpret: aNode continue: aBlock
  214. shouldReturn ifTrue: [ ^ self ].
  215. aNode isNode
  216. ifTrue: [
  217. currentNode := aNode.
  218. self interpretNode: aNode continue: [ :value |
  219. self continue: aBlock value: value ] ]
  220. ifFalse: [ self continue: aBlock value: aNode ]
  221. !
  222. interpretAssignmentNode: aNode continue: aBlock
  223. self interpret: aNode right continue: [ :value |
  224. self
  225. continue: aBlock
  226. value: (self assign: aNode left to: value) ]
  227. !
  228. interpretBlockNode: aNode continue: aBlock
  229. self
  230. continue: aBlock
  231. value: [
  232. self withBlockContext: [
  233. self interpret: aNode nodes first; result ] ]
  234. !
  235. interpretBlockSequenceNode: aNode continue: aBlock
  236. self interpretSequenceNode: aNode continue: aBlock
  237. !
  238. interpretCascadeNode: aNode continue: aBlock
  239. "TODO: Handle super sends"
  240. self interpret: aNode receiver continue: [ :receiver |
  241. "Only interpret the receiver once"
  242. aNode nodes do: [ :each | each receiver: receiver ].
  243. self
  244. interpretAll: aNode nodes allButLast
  245. continue: [
  246. self
  247. interpret: aNode nodes last
  248. continue: [ :val | self continue: aBlock value: val ] ] ]
  249. !
  250. interpretClassReferenceNode: aNode continue: aBlock
  251. self continue: aBlock value: (Smalltalk current at: aNode value)
  252. !
  253. interpretDynamicArrayNode: aNode continue: aBlock
  254. self interpretAll: aNode nodes continue: [ :array |
  255. self
  256. continue: aBlock
  257. value: array ]
  258. !
  259. interpretDynamicDictionaryNode: aNode continue: aBlock
  260. self interpretAll: aNode nodes continue: [ :array | | hashedCollection |
  261. hashedCollection := HashedCollection new.
  262. array do: [ :each | hashedCollection add: each ].
  263. self
  264. continue: aBlock
  265. value: hashedCollection ]
  266. !
  267. interpretJSStatementNode: aNode continue: aBlock
  268. shouldReturn := true.
  269. self continue: aBlock value: (self eval: aNode source)
  270. !
  271. interpretMethodNode: aNode continue: aBlock
  272. self interpretAll: aNode nodes continue: [ :array |
  273. self continue: aBlock value: array first ]
  274. !
  275. interpretNode: aNode continue: aBlock
  276. aNode interpreter: self continue: aBlock
  277. !
  278. interpretReturnNode: aNode continue: aBlock
  279. self interpret: aNode nodes first continue: [ :value |
  280. shouldReturn := true.
  281. self continue: aBlock value: value ]
  282. !
  283. interpretSendNode: aNode continue: aBlock
  284. self interpret: aNode receiver continue: [ :receiver |
  285. self interpretAll: aNode arguments continue: [ :args |
  286. self
  287. messageFromSendNode: aNode
  288. arguments: args
  289. do: [ :message |
  290. self context pc: self context pc + 1.
  291. self
  292. continue: aBlock
  293. value: (self sendMessage: message to: receiver superSend: aNode superSend) ] ] ]
  294. !
  295. interpretSequenceNode: aNode continue: aBlock
  296. self interpretAll: aNode nodes continue: [ :array |
  297. self continue: aBlock value: array last ]
  298. !
  299. interpretValueNode: aNode continue: aBlock
  300. self continue: aBlock value: aNode value
  301. !
  302. interpretVariableNode: aNode continue: aBlock
  303. self
  304. continue: aBlock
  305. value: (aNode binding isInstanceVar
  306. ifTrue: [ self context receiver instVarAt: aNode value ]
  307. ifFalse: [ self context localAt: aNode value ])
  308. ! !
  309. !ASTInterpreter methodsFor: 'private'!
  310. assign: aNode to: anObject
  311. ^ aNode binding isInstanceVar
  312. ifTrue: [ self context receiver instVarAt: aNode value put: anObject ]
  313. ifFalse: [ self context localAt: aNode value put: anObject ]
  314. !
  315. continue: aBlock value: anObject
  316. result := anObject.
  317. aBlock value: anObject
  318. !
  319. eval: aString
  320. "Evaluate aString as JS source inside an JS function.
  321. aString is not sandboxed."
  322. | source function |
  323. source := String streamContents: [ :str |
  324. str nextPutAll: '(function('.
  325. self context locals keys
  326. do: [ :each | str nextPutAll: each ]
  327. separatedBy: [ str nextPutAll: ',' ].
  328. str
  329. nextPutAll: '){ return (function() {';
  330. nextPutAll: aString;
  331. nextPutAll: '})() })' ].
  332. function := Compiler new eval: source.
  333. ^ function valueWithPossibleArguments: self context locals values
  334. !
  335. interpretAll: aCollection continue: aBlock
  336. self
  337. interpretAll: aCollection
  338. continue: aBlock
  339. result: OrderedCollection new
  340. !
  341. interpretAll: nodes continue: aBlock result: aCollection
  342. nodes isEmpty
  343. ifTrue: [ self continue: aBlock value: aCollection ]
  344. ifFalse: [
  345. self interpret: nodes first continue: [:value |
  346. self
  347. interpretAll: nodes allButFirst
  348. continue: aBlock
  349. result: aCollection, { value } ] ]
  350. !
  351. messageFromSendNode: aSendNode arguments: aCollection do: aBlock
  352. self
  353. continue: aBlock
  354. value: (Message new
  355. selector: aSendNode selector;
  356. arguments: aCollection;
  357. yourself)
  358. !
  359. sendMessage: aMessage to: anObject superSend: aBoolean
  360. | method |
  361. aBoolean ifFalse: [ ^ aMessage sendTo: anObject ].
  362. anObject class superclass ifNil: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
  363. method := anObject class superclass methodDictionary
  364. at: aMessage selector
  365. ifAbsent: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
  366. ^ method fn applyTo: anObject arguments: aMessage arguments
  367. !
  368. withBlockContext: aBlock
  369. "Evaluate aBlock with a BlockContext:
  370. - a context is pushed before aBlock evaluation.
  371. - the context is poped after aBlock evaluation
  372. - the result of aBlock evaluation is answered"
  373. | blockResult |
  374. self context: (AIContext new
  375. outerContext: self context;
  376. yourself).
  377. blockResult := aBlock value.
  378. self context: self context outerContext.
  379. ^ blockResult
  380. ! !
  381. !ASTInterpreter methodsFor: 'testing'!
  382. shouldReturn
  383. ^ shouldReturn ifNil: [ false ]
  384. ! !
  385. ASTInterpreter subclass: #ASTSteppingInterpreter
  386. instanceVariableNames: 'continuation nextNode'
  387. package: 'Compiler-Interpreter'!
  388. !ASTSteppingInterpreter commentStamp!
  389. I am an interpreter with stepping capabilities. The higher level `ASTDebugger` class should be used as a debugger model, as it provides convenience methods for debugging.
  390. ## API
  391. Use `#step` to actually interpret the next node. Interpretation stops at each node evaluation, weither it's a message node or not.
  392. ## Usage example:
  393. | ast interpreter |
  394. ast := Smalltalk current parse: 'foo 1+2+4'.
  395. (SemanticAnalyzer on: Object) visit: ast.
  396. interpreter := ASTSteppingInterpreter new
  397. interpret: ast nodes first;
  398. yourself.
  399. interpreter step; step.
  400. interpreter step; step.
  401. interpreter result."Answers 1"
  402. interpreter step.
  403. interpreter result. "Answers 3"
  404. interpreter step.
  405. interpreter result. "Answers 7"!
  406. !ASTSteppingInterpreter methodsFor: 'accessing'!
  407. nextNode
  408. ^ nextNode
  409. ! !
  410. !ASTSteppingInterpreter methodsFor: 'initialization'!
  411. initialize
  412. super initialize.
  413. continuation := []
  414. ! !
  415. !ASTSteppingInterpreter methodsFor: 'interpreting'!
  416. interpret: aNode continue: aBlock
  417. nextNode := aNode.
  418. continuation := [
  419. super interpret: aNode continue: aBlock ]
  420. ! !
  421. !ASTSteppingInterpreter methodsFor: 'stepping'!
  422. step
  423. continuation value
  424. ! !
  425. !ASTSteppingInterpreter methodsFor: 'testing'!
  426. atEnd
  427. ^ self shouldReturn or: [ self nextNode == self currentNode ]
  428. ! !
  429. NodeVisitor subclass: #ASTPCNodeVisitor
  430. instanceVariableNames: 'useInlinings pc context currentNode'
  431. package: 'Compiler-Interpreter'!
  432. !ASTPCNodeVisitor commentStamp!
  433. I visit an AST until I get to the current pc node and answer it.
  434. ## API
  435. My instances must be filled with a context object using `#context:`.
  436. After visiting the AST the current node corresponding to the `pc` is answered by `#currentNode`!
  437. !ASTPCNodeVisitor methodsFor: 'accessing'!
  438. context
  439. ^ context
  440. !
  441. context: aContext
  442. context := aContext
  443. !
  444. currentNode
  445. ^ currentNode
  446. !
  447. pc
  448. ^ pc ifNil: [ 0 ]
  449. !
  450. pc: anInteger
  451. pc := anInteger
  452. !
  453. useInlinings
  454. ^ useInlinings ifNil: [ true ]
  455. !
  456. useInlinings: aBoolean
  457. useInlinings := aBoolean
  458. ! !
  459. !ASTPCNodeVisitor methodsFor: 'visiting'!
  460. visitJSStatementNode: aNode
  461. currentNode := aNode
  462. !
  463. visitSendNode: aNode
  464. super visitSendNode: aNode.
  465. self pc = self context pc ifFalse: [
  466. aNode shouldBeInlined ifFalse: [
  467. self pc: self pc + 1.
  468. currentNode := aNode ] ]
  469. ! !
  470. !Node methodsFor: '*Compiler-Interpreter'!
  471. interpreter: anInterpreter continue: aBlock
  472. ^ anInterpreter interpretNode: self continue: aBlock
  473. !
  474. isSteppingNode
  475. ^ false
  476. ! !
  477. !AssignmentNode methodsFor: '*Compiler-Interpreter'!
  478. interpreter: anInterpreter continue: aBlock
  479. ^ anInterpreter interpretAssignmentNode: self continue: aBlock
  480. !
  481. isSteppingNode
  482. ^ true
  483. ! !
  484. !BlockNode methodsFor: '*Compiler-Interpreter'!
  485. interpreter: anInterpreter continue: aBlock
  486. ^ anInterpreter interpretBlockNode: self continue: aBlock
  487. !
  488. isSteppingNode
  489. ^ true
  490. ! !
  491. !CascadeNode methodsFor: '*Compiler-Interpreter'!
  492. interpreter: anInterpreter continue: aBlock
  493. ^ anInterpreter interpretCascadeNode: self continue: aBlock
  494. ! !
  495. !DynamicArrayNode methodsFor: '*Compiler-Interpreter'!
  496. interpreter: anInterpreter continue: aBlock
  497. ^ anInterpreter interpretDynamicArrayNode: self continue: aBlock
  498. !
  499. isSteppingNode
  500. ^ true
  501. ! !
  502. !DynamicDictionaryNode methodsFor: '*Compiler-Interpreter'!
  503. interpreter: anInterpreter continue: aBlock
  504. ^ anInterpreter interpretDynamicDictionaryNode: self continue: aBlock
  505. !
  506. isSteppingNode
  507. ^ true
  508. ! !
  509. !JSStatementNode methodsFor: '*Compiler-Interpreter'!
  510. interpreter: anInterpreter continue: aBlock
  511. ^ anInterpreter interpretJSStatementNode: self continue: aBlock
  512. !
  513. isSteppingNode
  514. ^ true
  515. ! !
  516. !MethodNode methodsFor: '*Compiler-Interpreter'!
  517. interpreter: anInterpreter continue: aBlock
  518. ^ anInterpreter interpretMethodNode: self continue: aBlock
  519. ! !
  520. !ReturnNode methodsFor: '*Compiler-Interpreter'!
  521. interpreter: anInterpreter continue: aBlock
  522. ^ anInterpreter interpretReturnNode: self continue: aBlock
  523. ! !
  524. !SendNode methodsFor: '*Compiler-Interpreter'!
  525. interpreter: anInterpreter continue: aBlock
  526. ^ anInterpreter interpretSendNode: self continue: aBlock
  527. !
  528. isSteppingNode
  529. ^ true
  530. ! !
  531. !SequenceNode methodsFor: '*Compiler-Interpreter'!
  532. interpreter: anInterpreter continue: aBlock
  533. ^ anInterpreter interpretSequenceNode: self continue: aBlock
  534. ! !
  535. !BlockSequenceNode methodsFor: '*Compiler-Interpreter'!
  536. interpreter: anInterpreter continue: aBlock
  537. ^ anInterpreter interpretBlockSequenceNode: self continue: aBlock
  538. ! !
  539. !ValueNode methodsFor: '*Compiler-Interpreter'!
  540. interpreter: anInterpreter continue: aBlock
  541. ^ anInterpreter interpretValueNode: self continue: aBlock
  542. ! !
  543. !VariableNode methodsFor: '*Compiler-Interpreter'!
  544. interpreter: anInterpreter continue: aBlock
  545. ^ anInterpreter interpretVariableNode: self continue: aBlock
  546. ! !
  547. !ClassReferenceNode methodsFor: '*Compiler-Interpreter'!
  548. interpreter: anInterpreter continue: aBlock
  549. ^ anInterpreter interpretClassReferenceNode: self continue: aBlock
  550. ! !