amber/st/Compiler-Interpreter.st

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
! !