Compiler-Interpreter.st 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128
  1. Smalltalk current createPackage: 'Compiler-Interpreter' properties: #{}!
  2. NodeVisitor subclass: #ASTInterpreter
  3. instanceVariableNames: 'currentNode context shouldReturn'
  4. package: 'Compiler-Interpreter'!
  5. !ASTInterpreter methodsFor: 'accessing'!
  6. context
  7. ^ context
  8. !
  9. context: aMethodContext
  10. context := aMethodContext
  11. ! !
  12. !ASTInterpreter methodsFor: 'initialization'!
  13. initialize
  14. super initialize.
  15. shouldReturn := false
  16. ! !
  17. !ASTInterpreter methodsFor: 'interpreting'!
  18. blockValue: anASTBlockClosure
  19. ^ self interpret: anASTBlockClosure astNode nodes first
  20. !
  21. interpret: aNode
  22. shouldReturn := false.
  23. ^ self interpretNode: aNode
  24. !
  25. interpretNode: aNode
  26. currentNode := aNode.
  27. ^ self visit: aNode
  28. !
  29. send: aSelector to: anObject arguments: aCollection
  30. ^ anObject perform: aSelector withArguments: aCollection
  31. ! !
  32. !ASTInterpreter methodsFor: 'visiting'!
  33. visitBlockNode: aNode
  34. ^ [ self interpretNode: aNode nodes first ]
  35. !
  36. visitCascadeNode: aNode
  37. aNode nodes allButLast
  38. do: [ :each |
  39. each receiver: aNode receiver.
  40. self interpretNode: each ].
  41. aNode nodes last receiver: aNode receiver.
  42. ^ self interpretNode: aNode nodes last
  43. !
  44. visitJSStatementNode: aNode
  45. self halt
  46. !
  47. visitReturnNode: aNode
  48. shouldReturn := true.
  49. ^ self interpretNode: aNode nodes first
  50. !
  51. visitSendNode: aNode
  52. "TODO: Handle super sends"
  53. | receiver arguments |
  54. receiver := self interpretNode: aNode receiver.
  55. arguments := aNode arguments collect: [ :each |
  56. self interpretNode: each ].
  57. ^ self send: aNode selector to: receiver arguments: arguments
  58. !
  59. visitSequenceNode: aNode
  60. aNode nodes allButLast do: [ :each | | value |
  61. value := self interpretNode: each.
  62. shouldReturn ifTrue: [ ^ value ] ].
  63. ^ self interpretNode: aNode nodes last
  64. !
  65. visitValueNode: aNode
  66. ^ aNode value
  67. ! !
  68. TestCase subclass: #ASTInterpreterTest
  69. instanceVariableNames: ''
  70. package: 'Compiler-Interpreter'!
  71. !ASTInterpreterTest methodsFor: 'accessing'!
  72. analyze: aNode forClass: aClass
  73. (SemanticAnalyzer on: aClass) visit: aNode.
  74. ^ aNode
  75. !
  76. interpret: aString
  77. "the food is a methodNode. Interpret the sequenceNode only"
  78. ^ ASTInterpreter new
  79. interpret: (self parse: aString forClass: Object)
  80. nodes first
  81. !
  82. parse: aString
  83. ^ Smalltalk current parse: aString
  84. !
  85. parse: aString forClass: aClass
  86. ^ self analyze: (self parse: aString) forClass: aClass
  87. ! !
  88. !ASTInterpreterTest methodsFor: 'tests'!
  89. testBinarySend
  90. self assert: (self interpret: 'foo 2+3+4') equals: 9
  91. !
  92. testBlockLiteral
  93. self assert: (self interpret: 'foo ^ true ifTrue: [ 1 ] ifFalse: [ 2 ]') equals: 1.
  94. self assert: (self interpret: 'foo true ifTrue: [ ^ 1 ] ifFalse: [ 2 ]') equals: 1.
  95. self assert: (self interpret: 'foo ^ false ifTrue: [ 1 ] ifFalse: [ 2 ]') equals: 2
  96. ! !