Smalltalk current createPackage: 'Compiler-Interpreter'! NodeVisitor subclass: #AIContext instanceVariableNames: 'methodContext outerContext pc locals method' package: 'Compiler-Interpreter'! !AIContext commentStamp! I am like a `MethodContext`, used by the `ASTInterpreter`. Unlike a `MethodContext`, my instances are not read-only. When debugging, my instances are created by copying the current `MethodContext` (thisContext)! !AIContext methodsFor: 'accessing'! home ^ self isBlockContext ifTrue: [ self outerContext methodContext ] ifFalse: [ self ] ! localAt: aString ^ self locals at: aString ifAbsent: [ nil ] ! localAt: aString put: anObject self locals at: aString put: anObject ! locals locals ifNil: [ self initializeLocals ]. ^ locals ! 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 method ifNotNil: [ self method selector ] ! ! !AIContext methodsFor: 'converting'! asString ^ methodContext asString ! ! !AIContext methodsFor: 'initialization'! initializeFromMethodContext: aMethodContext methodContext := 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 ] ! initializeLocals locals := Dictionary new. locals at: 'thisContext' put: self. ! ! !AIContext methodsFor: 'testing'! isBlockContext ^ methodContext isBlockContext ! ! !AIContext class methodsFor: 'instance creation'! fromMethodContext: aMethodContext ^ self new initializeFromMethodContext: aMethodContext; yourself ! ! Object subclass: #ASTDebugger instanceVariableNames: 'interpreter context' package: 'Compiler-Interpreter'! !ASTDebugger commentStamp! I am a stepping debugger interface for Amber code. I internally use an instance of `ASTSteppingInterpreter` to actually step through node and interpret them. My instances are created from a `MethodContext` with `ASTDebugger class >> context:`. They hold an `AIContext` instance internally, recursive copy of the `MethodContext`. ## API Use the methods of the `'stepping'` protocol to do stepping.! !ASTDebugger methodsFor: 'accessing'! context ^ context ! context: aContext context := aContext ! interpreter ^ interpreter ifNil: [ interpreter := self defaultInterpreterClass new ] ! interpreter: anInterpreter interpreter := anInterpreter ! method ^ self context method ! nextNode ^ self interpreter nextNode ! ! !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 | ast next | ast := self buildAST. next := ASTPCNodeVisitor new context: self context; visit: ast; currentNode. self interpreter interpret: next ! initializeWithContext: aContext "TODO: do we need to handle block contexts?" self context: aContext. self initializeInterpreter ! ! !ASTDebugger methodsFor: 'stepping'! proceed self shouldBeImplemented ! restart 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 methodsFor: 'testing'! atEnd ^ self interpreter atEnd ! ! !ASTDebugger class methodsFor: 'instance creation'! context: aContext ^ self new initializeWithContext: aContext; yourself ! ! Object subclass: #ASTInterpreter instanceVariableNames: 'currentNode context shouldReturn result' package: 'Compiler-Interpreter'! !ASTInterpreter commentStamp! I am like a `NodeVisitor`, interpreting nodes one after each other. I am 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 self continue: aBlock value: [ self withBlockContext: [ 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 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: (self sendMessage: message to: receiver superSend: aNode superSend) ] ] ] ! 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) ! sendMessage: aMessage to: anObject superSend: aBoolean | method | aBoolean ifFalse: [ ^ aMessage sendTo: anObject ]. anObject class superclass ifNil: [ ^ self messageNotUnderstood: aMessage receiver: anObject ]. method := anObject class superclass methodDictionary at: aMessage selector ifAbsent: [ ^ self messageNotUnderstood: aMessage receiver: anObject ]. ^ method fn applyTo: anObject arguments: aMessage arguments ! withBlockContext: aBlock "Evaluate aBlock with a BlockContext: - a context is pushed before aBlock evaluation. - the context is poped after aBlock evaluation - the result of aBlock evaluation is answered" | blockResult | self context: (AIContext new outerContext: self context; yourself). blockResult := aBlock value. self context: self context outerContext. ^ blockResult ! ! !ASTInterpreter methodsFor: 'testing'! shouldReturn ^ shouldReturn ifNil: [ false ] ! ! ASTInterpreter subclass: #ASTSteppingInterpreter instanceVariableNames: 'continuation nextNode' package: 'Compiler-Interpreter'! !ASTSteppingInterpreter commentStamp! 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. ## API Use `#step` to actually interpret the next node. Interpretation stops at each node evaluation, weither it's a message node or not. ## 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. interpreter step; step. interpreter step; step. interpreter result."Answers 1" interpreter step. interpreter result. "Answers 3" interpreter step. interpreter 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 ] ! ! NodeVisitor subclass: #ASTPCNodeVisitor instanceVariableNames: 'useInlinings pc context currentNode' package: 'Compiler-Interpreter'! !ASTPCNodeVisitor commentStamp! I visit an AST until I get to the current pc node and answer it. ## API My instances must be filled with a context object using `#context:`. After visiting the AST the current node corresponding to the `pc` is answered by `#currentNode`! !ASTPCNodeVisitor methodsFor: 'accessing'! context ^ context ! context: aContext context := aContext ! currentNode ^ currentNode ! pc ^ pc ifNil: [ 0 ] ! pc: anInteger pc := anInteger ! useInlinings ^ useInlinings ifNil: [ true ] ! useInlinings: aBoolean useInlinings := aBoolean ! ! !ASTPCNodeVisitor methodsFor: 'visiting'! visitJSStatementNode: aNode currentNode := aNode ! visitSendNode: aNode super visitSendNode: aNode. self pc = self context pc ifFalse: [ aNode shouldBeInlined ifFalse: [ self pc: self pc + 1. currentNode := aNode ] ] ! ! !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 ! !