Smalltalk current createPackage: 'Compiler-Interpreter'!
NodeVisitor subclass: #AIContext
instanceVariableNames: 'outerContext pc locals method'
package: 'Compiler-Interpreter'!
!AIContext commentStamp!
AIContext is like a `MethodContext`, used by the `ASTInterpreter`.
Unlike a `MethodContext`, it is not read-only.
When debugging, `AIContext` instances are created by copying the current `MethodContext` (thisContext)!
!AIContext methodsFor: 'accessing'!
localAt: aString
^ self locals at: aString ifAbsent: [ nil ]
!
localAt: aString put: anObject
self locals at: aString put: anObject
!
locals
^ locals ifNil: [ locals := Dictionary new ]
!
method
^ method
!
method: aCompiledMethod
method := aCompiledMethod
!
outerContext
^ outerContext
!
outerContext: anAIContext
outerContext := anAIContext
!
pc
^ pc ifNil: [ pc := 0 ]
!
pc: anInteger
pc := anInteger
!
receiver
^ self localAt: 'self'
!
receiver: anObject
self localAt: 'self' put: anObject
!
selector
^ self metod
ifNotNil: [ self method selector ]
! !
!AIContext methodsFor: 'initialization'!
initializeFromMethodContext: aMethodContext
self pc: aMethodContext pc.
self receiver: aMethodContext receiver.
self method: aMethodContext method.
aMethodContext outerContext ifNotNil: [
self outerContext: (self class fromMethodContext: aMethodContext outerContext) ].
aMethodContext locals keysAndValuesDo: [ :key :value |
self locals at: key put: value ]
! !
!AIContext class methodsFor: 'instance creation'!
fromMethodContext: aMethodContext
^ self new
initializeFromMethodContext: aMethodContext;
yourself
! !
Object subclass: #ASTDebugger
instanceVariableNames: 'interpreter context'
package: 'Compiler-Interpreter'!
!ASTDebugger commentStamp!
ASTDebugger is a debugger to Amber.
It uses an AST interpreter to step through the code.
ASTDebugger instances are created from a `MethodContext` with `ASTDebugger class >> context:`.
They hold an `AIContext` instance internally, recursive copy of the `MethodContext`.
Use the methods of the 'stepping' protocol to do stepping.!
!ASTDebugger methodsFor: 'accessing'!
context
^ context
!
context: aContext
context := AIContext new.
!
interpreter
^ interpreter ifNil: [ interpreter := self defaultInterpreterClass new ]
!
interpreter: anInterpreter
interpreter := anInterpreter
!
method
^ self context method
! !
!ASTDebugger methodsFor: 'defaults'!
defaultInterpreterClass
^ ASTSteppingInterpreter
! !
!ASTDebugger methodsFor: 'initialization'!
buildAST
"Build the AST tree from the method source code.
The AST is annotated with a SemanticAnalyzer,
to know the semantics and bindings of each node needed for later debugging"
| ast |
ast := Smalltalk current parse: self method source.
(SemanticAnalyzer on: self context receiver class)
visit: ast.
^ ast
!
initializeInterpreter
self interpreter interpret: self buildAST nodes first
!
initializeWithContext: aMethodContext
"TODO: do we need to handle block contexts?"
self context: (AIContext fromMethodContext: aMethodContext).
self initializeInterpreter
! !
!ASTDebugger methodsFor: 'stepping'!
restart
self shouldBeImplemented
!
resume
self shouldBeImplemented
!
step
"The ASTSteppingInterpreter stops at each node interpretation.
One step will interpret nodes until:
- we get at the end
- the next node is a stepping node (send, assignment, etc.)"
[ (self interpreter nextNode notNil and: [ self interpreter nextNode stopOnStepping ])
or: [ self interpreter atEnd not ] ]
whileFalse: [
self interpreter step.
self step ]
!
stepInto
self shouldBeImplemented
!
stepOver
self step
! !
!ASTDebugger class methodsFor: 'instance creation'!
context: aMethodContext
^ self new
initializeWithContext: aMethodContext;
yourself
! !
Object subclass: #ASTInterpreter
instanceVariableNames: 'currentNode context shouldReturn result'
package: 'Compiler-Interpreter'!
!ASTInterpreter commentStamp!
ASTIntepreter is like a `NodeVisitor`, interpreting nodes one after each other.
It is built using Continuation Passing Style for stepping purposes.
Usage example:
| ast interpreter |
ast := Smalltalk current parse: 'foo 1+2+4'.
(SemanticAnalyzer on: Object) visit: ast.
ASTInterpreter new
interpret: ast nodes first;
result "Answers 7"!
!ASTInterpreter methodsFor: 'accessing'!
context
^ context ifNil: [ context := AIContext new ]
!
context: anAIContext
context := anAIContext
!
currentNode
^ currentNode
!
result
^ result
! !
!ASTInterpreter methodsFor: 'initialization'!
initialize
super initialize.
shouldReturn := false
! !
!ASTInterpreter methodsFor: 'interpreting'!
interpret: aNode
shouldReturn := false.
self interpret: aNode continue: [ :value |
result := value ]
!
interpret: aNode continue: aBlock
shouldReturn ifTrue: [ ^ self ].
aNode isNode
ifTrue: [
currentNode := aNode.
self interpretNode: aNode continue: [ :value |
self continue: aBlock value: value ] ]
ifFalse: [ self continue: aBlock value: aNode ]
!
interpretAssignmentNode: aNode continue: aBlock
self interpret: aNode right continue: [ :value |
self
continue: aBlock
value: (self assign: aNode left to: value) ]
!
interpretBlockNode: aNode continue: aBlock
"TODO: Context should be set"
self
continue: aBlock
value: [ self interpret: aNode nodes first; result ]
!
interpretBlockSequenceNode: aNode continue: aBlock
self interpretSequenceNode: aNode continue: aBlock
!
interpretCascadeNode: aNode continue: aBlock
"TODO: Handle super sends"
self interpret: aNode receiver continue: [ :receiver |
"Only interpret the receiver once"
aNode nodes do: [ :each | each receiver: receiver ].
self
interpretAll: aNode nodes allButLast
continue: [
self
interpret: aNode nodes last
continue: [ :val | self continue: aBlock value: val ] ] ]
!
interpretClassReferenceNode: aNode continue: aBlock
self continue: aBlock value: (Smalltalk current at: aNode value)
!
interpretDynamicArrayNode: aNode continue: aBlock
self interpretAll: aNode nodes continue: [ :array |
self
continue: aBlock
value: array ]
!
interpretDynamicDictionaryNode: aNode continue: aBlock
self interpretAll: aNode nodes continue: [ :array | | hashedCollection |
hashedCollection := HashedCollection new.
array do: [ :each | hashedCollection add: each ].
self
continue: aBlock
value: hashedCollection ]
!
interpretJSStatementNode: aNode continue: aBlock
shouldReturn := true.
self continue: aBlock value: (self eval: aNode source)
!
interpretMethodNode: aNode continue: aBlock
self interpretAll: aNode nodes continue: [ :array |
self continue: aBlock value: array first ]
!
interpretNode: aNode continue: aBlock
aNode interpreter: self continue: aBlock
!
interpretReturnNode: aNode continue: aBlock
self interpret: aNode nodes first continue: [ :value |
shouldReturn := true.
self continue: aBlock value: value ]
!
interpretSendNode: aNode continue: aBlock
"TODO: Handle super sends"
self interpret: aNode receiver continue: [ :receiver |
self interpretAll: aNode arguments continue: [ :args |
self
messageFromSendNode: aNode
arguments: args
do: [ :message |
self context pc: self context pc + 1.
self
continue: aBlock
value: (message sendTo: receiver) ] ] ]
!
interpretSequenceNode: aNode continue: aBlock
self interpretAll: aNode nodes continue: [ :array |
self continue: aBlock value: array last ]
!
interpretValueNode: aNode continue: aBlock
self continue: aBlock value: aNode value
!
interpretVariableNode: aNode continue: aBlock
self
continue: aBlock
value: (aNode binding isInstanceVar
ifTrue: [ self context receiver instVarAt: aNode value ]
ifFalse: [ self context localAt: aNode value ])
! !
!ASTInterpreter methodsFor: 'private'!
assign: aNode to: anObject
^ aNode binding isInstanceVar
ifTrue: [ self context receiver instVarAt: aNode value put: anObject ]
ifFalse: [ self context localAt: aNode value put: anObject ]
!
continue: aBlock value: anObject
result := anObject.
aBlock value: anObject
!
eval: aString
"Evaluate aString as JS source inside an JS function.
aString is not sandboxed."
| source function |
source := String streamContents: [ :str |
str nextPutAll: '(function('.
self context locals keys
do: [ :each | str nextPutAll: each ]
separatedBy: [ str nextPutAll: ',' ].
str
nextPutAll: '){ return (function() {';
nextPutAll: aString;
nextPutAll: '})() })' ].
function := Compiler new eval: source.
^ function valueWithPossibleArguments: self context locals values
!
interpretAll: aCollection continue: aBlock
self
interpretAll: aCollection
continue: aBlock
result: OrderedCollection new
!
interpretAll: nodes continue: aBlock result: aCollection
nodes isEmpty
ifTrue: [ self continue: aBlock value: aCollection ]
ifFalse: [
self interpret: nodes first continue: [:value |
self
interpretAll: nodes allButFirst
continue: aBlock
result: aCollection, { value } ] ]
!
messageFromSendNode: aSendNode arguments: aCollection do: aBlock
self
continue: aBlock
value: (Message new
selector: aSendNode selector;
arguments: aCollection;
yourself)
! !
!ASTInterpreter methodsFor: 'testing'!
shouldReturn
^ shouldReturn ifNil: [ false ]
! !
ASTInterpreter subclass: #ASTSteppingInterpreter
instanceVariableNames: 'continuation nextNode'
package: 'Compiler-Interpreter'!
!ASTSteppingInterpreter commentStamp!
ASTSteppingInterpreter is an interpreter with stepping capabilities.
Use `#step` to actually interpret the next node.
Usage example:
| ast interpreter |
ast := Smalltalk current parse: 'foo 1+2+4'.
(SemanticAnalyzer on: Object) visit: ast.
interpreter := ASTSteppingInterpreter new
interpret: ast nodes first;
yourself.
debugger step; step.
debugger step; step.
debugger result."Answers 1"
debugger step.
debugger result. "Answers 3"
debugger step.
debugger result. "Answers 7"!
!ASTSteppingInterpreter methodsFor: 'accessing'!
nextNode
^ nextNode
! !
!ASTSteppingInterpreter methodsFor: 'initialization'!
initialize
super initialize.
continuation := [ ]
! !
!ASTSteppingInterpreter methodsFor: 'interpreting'!
interpret: aNode continue: aBlock
nextNode := aNode.
continuation := [
super interpret: aNode continue: aBlock ]
! !
!ASTSteppingInterpreter methodsFor: 'stepping'!
step
continuation value
! !
!ASTSteppingInterpreter methodsFor: 'testing'!
atEnd
^ self shouldReturn or: [ self nextNode == self currentNode ]
! !
!Node methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretNode: self continue: aBlock
!
isSteppingNode
^ false
! !
!AssignmentNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretAssignmentNode: self continue: aBlock
!
isSteppingNode
^ true
! !
!BlockNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretBlockNode: self continue: aBlock
!
isSteppingNode
^ true
! !
!CascadeNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretCascadeNode: self continue: aBlock
! !
!DynamicArrayNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretDynamicArrayNode: self continue: aBlock
!
isSteppingNode
^ true
! !
!DynamicDictionaryNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretDynamicDictionaryNode: self continue: aBlock
!
isSteppingNode
^ true
! !
!JSStatementNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretJSStatementNode: self continue: aBlock
!
isSteppingNode
^ true
! !
!MethodNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretMethodNode: self continue: aBlock
! !
!ReturnNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretReturnNode: self continue: aBlock
! !
!SendNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretSendNode: self continue: aBlock
!
isSteppingNode
^ true
! !
!SequenceNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretSequenceNode: self continue: aBlock
! !
!BlockSequenceNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretBlockSequenceNode: self continue: aBlock
! !
!ValueNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretValueNode: self continue: aBlock
! !
!VariableNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretVariableNode: self continue: aBlock
! !
!ClassReferenceNode methodsFor: '*Compiler-Interpreter'!
interpreter: anInterpreter continue: aBlock
^ anInterpreter interpretClassReferenceNode: self continue: aBlock
! !