| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133 | 
							- Smalltalk createPackage: 'Compiler-Interpreter'!
 
- BlockClosure subclass: #AIBlockClosure
 
- 	slots: {#node. #outerContext}
 
- 	package: 'Compiler-Interpreter'!
 
- !AIBlockClosure commentStamp!
 
- I am a special `BlockClosure` subclass used by an interpreter to interpret a block node.
 
- While I am polymorphic with `BlockClosure`, some methods such as `#new` will raise interpretation errors. Unlike a `BlockClosure`, my instance are not JavaScript functions.
 
- Evaluating an instance will result in interpreting the `node` instance variable (instance of `BlockNode`).!
 
- !AIBlockClosure methodsFor: 'accessing'!
 
- compiledSource
 
- 	"Unlike blocks, the receiver doesn't represent a JS function"
 
- 	
 
- 	^ '[ AST Block closure ]'
 
- !
 
- numArgs
 
- 	^ node temps size
 
- ! !
 
- !AIBlockClosure methodsFor: 'converting'!
 
- currySelf
 
- 	self interpreterError
 
- ! !
 
- !AIBlockClosure methodsFor: 'error handling'!
 
- interpreterError
 
- 	ASTInterpreterError signal: 'Method cannot be interpreted by the interpreter.'
 
- ! !
 
- !AIBlockClosure methodsFor: 'evaluating'!
 
- applyTo: anObject arguments: aCollection
 
- 	self interpreterError
 
- !
 
- value
 
- 	^ self valueWithPossibleArguments: #()
 
- !
 
- value: anArgument
 
- 	^ self valueWithPossibleArguments: {anArgument}
 
- !
 
- value: firstArgument value: secondArgument
 
- 	^ self valueWithPossibleArguments: {firstArgument . secondArgument}
 
- !
 
- value: firstArgument value: secondArgument value: thirdArgument
 
- 	^ self valueWithPossibleArguments: {firstArgument . secondArgument . thirdArgument}
 
- !
 
- valueWithPossibleArguments: aCollection
 
- 	| context sequenceNode |
 
- 	context := outerContext newInnerContext.
 
- 	"Interpret a copy of the sequence node to avoid creating a new AIBlockClosure"
 
- 	sequenceNode := node sequenceNode copy
 
- 		parent: nil;
 
- 		yourself.
 
- 		
 
- 	"Define locals in the context"
 
- 	sequenceNode temps do: [ :each |
 
- 		context defineLocal: each ].
 
- 		
 
- 	"Populate the arguments into the context locals"	
 
- 	node parameters withIndexDo: [ :each :index |
 
- 		context defineLocal: each.
 
- 		context localAt: each put: (aCollection at: index ifAbsent: [ nil ]) ].
 
- 	"Interpret the first node of the BlockSequenceNode"
 
- 	context interpreter
 
- 		node: sequenceNode;
 
- 		enterNode;
 
- 		proceed.
 
- 		
 
- 	outerContext interpreter
 
- 		setNonLocalReturnFromContext: context.
 
- 		
 
- 	^ context interpreter pop
 
- ! !
 
- !AIBlockClosure methodsFor: 'initialization'!
 
- initializeWithContext: aContext node: aNode
 
- 	node := aNode.
 
- 	outerContext := aContext
 
- ! !
 
- !AIBlockClosure class methodsFor: 'instance creation'!
 
- forContext: aContext node: aNode
 
- 	^ self new
 
- 		initializeWithContext: aContext node: aNode;
 
- 		yourself
 
- ! !
 
- Object subclass: #AIContext
 
- 	slots: {#outerContext. #innerContext. #pc. #locals. #selector. #index. #sendIndexes. #evaluatedSelector. #ast. #interpreter. #supercall}
 
- 	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'!
 
- defineLocal: aString
 
- 	self locals at: aString put: nil
 
- !
 
- evaluatedSelector
 
- 	^ evaluatedSelector
 
- !
 
- evaluatedSelector: aString
 
- 	evaluatedSelector := aString
 
- !
 
- home
 
- 	^ nil
 
- !
 
- index
 
- 	^ index ifNil: [ 0 ]
 
- !
 
- index: anInteger
 
- 	index := anInteger
 
- !
 
- innerContext
 
- 	^ innerContext
 
- !
 
- innerContext: anAIContext
 
- 	innerContext := anAIContext
 
- !
 
- localAt: aString
 
- 	"Lookup the local value up to the method context"
 
- 	| context |
 
- 	
 
- 	context := self lookupContextForLocal: aString.
 
- 	^ context basicLocalAt: aString
 
- !
 
- localAt: aString ifAbsent: aBlock
 
- 	"Lookup the local value up to the method context"
 
- 	| context |
 
- 	
 
- 	context := self 	
 
- 		lookupContextForLocal: aString 
 
- 		ifNone: [ ^ aBlock value ].
 
- 	
 
- 	^ context basicLocalAt: aString
 
- !
 
- localAt: aString put: anObject
 
- 	| context |
 
- 	
 
- 	context := self lookupContextForLocal: aString.
 
- 	context basicLocalAt: aString put: anObject
 
- !
 
- locals
 
- 	locals ifNil: [ self initializeLocals ].
 
- 	
 
- 	^ locals
 
- !
 
- outerContext
 
- 	^ outerContext
 
- !
 
- outerContext: anAIContext
 
- 	outerContext := anAIContext.
 
- 	outerContext ifNotNil: [ :context | 
 
- 		context innerContext: self ]
 
- !
 
- selector
 
- 	^ selector
 
- !
 
- selector: aString
 
- 	selector := aString
 
- !
 
- sendIndexAt: aString
 
- 	^ self sendIndexes at: aString ifAbsent: [ 0 ]
 
- !
 
- sendIndexes
 
- 	^ sendIndexes ifNil: [ Dictionary new ]
 
- !
 
- sendIndexes: aDictionary
 
- 	sendIndexes := aDictionary
 
- ! !
 
- !AIContext methodsFor: 'error handling'!
 
- variableNotFound
 
- 	"Error thrown whenever a variable lookup fails"
 
- 	
 
- 	self error: 'Variable missing'
 
- ! !
 
- !AIContext methodsFor: 'evaluating'!
 
- evaluate: aString on: anEvaluator
 
- 	^ anEvaluator evaluate: aString context: self
 
- !
 
- evaluateNode: aNode
 
- 	^ ASTInterpreter new
 
- 		context: self;
 
- 		node: aNode;
 
- 		enterNode;
 
- 		proceed;
 
- 		result
 
- ! !
 
- !AIContext methodsFor: 'factory'!
 
- newInnerContext
 
- 	^ self class new
 
- 		outerContext: self;
 
- 		yourself
 
- ! !
 
- !AIContext methodsFor: 'initialization'!
 
- initializeAST
 
- 	ast := self method ast.
 
- 	(SemanticAnalyzer on: self method origin)
 
- 		visit: ast
 
- !
 
- initializeFromMethodContext: aMethodContext
 
- 	self
 
- 		evaluatedSelector: aMethodContext evaluatedSelector;
 
- 		index: aMethodContext index;
 
- 		sendIndexes: aMethodContext sendIndexes;
 
- 		receiver: aMethodContext receiver;
 
- 		supercall: aMethodContext supercall;
 
- 		selector: aMethodContext selector.
 
- 		
 
- 	aMethodContext outerContext ifNotNil: [ :outer |
 
- 		"If the method context is nil, the block was defined in JS, so ignore it"
 
- 		outer methodContext ifNotNil: [
 
- 			self outerContext: (self class fromMethodContext: aMethodContext outerContext) ].
 
- 			aMethodContext locals keysAndValuesDo: [ :key :value |
 
- 				self locals at: key put: value ] ]
 
- !
 
- initializeInterpreter
 
- 	interpreter := ASTInterpreter new
 
- 		context: self;
 
- 		yourself.
 
- 	
 
- 	self innerContext ifNotNil: [
 
- 		self setupInterpreter: interpreter ]
 
- !
 
- initializeLocals
 
- 	locals := Dictionary new.
 
- 	locals at: 'thisContext' put: self.
 
- ! !
 
- !AIContext methodsFor: 'interpreting'!
 
- arguments
 
- 	^ self ast arguments collect: [ :each |
 
- 		self localAt: each ifAbsent: [ self error: 'Argument not in context' ] ]
 
- !
 
- ast
 
- 	self isBlockContext ifTrue: [ 
 
- 		^ self outerContext ifNotNil: [ :context | context ast ] ].
 
- 	ast ifNil: [ self initializeAST ].
 
- 	^ ast
 
- !
 
- basicReceiver
 
- 	^ self localAt: 'self'
 
- !
 
- interpreter
 
- 	interpreter ifNil: [ self initializeInterpreter ].
 
- 	^ interpreter
 
- !
 
- interpreter: anInterpreter
 
- 	interpreter := anInterpreter
 
- !
 
- receiver: anObject
 
- 	self locals at: 'self' put: anObject
 
- !
 
- setupInterpreter: anInterpreter
 
- 	| currentNode |
 
- 	
 
- 	"Retrieve the current node"
 
- 	currentNode := ASTPCNodeVisitor new
 
- 			selector: self evaluatedSelector;
 
- 			index: (self sendIndexAt: self evaluatedSelector);
 
- 			visit: self ast;
 
- 			currentNode.
 
- 	
 
- 	"Define locals for the context"
 
- 	self ast sequenceNode ifNotNil: [ :sequence |
 
- 		sequence temps do: [ :each |
 
- 			self defineLocal: each ] ].
 
- 	
 
- 	anInterpreter node: currentNode.
 
- 	"Push the send args and receiver to the interpreter stack"	
 
- 	self innerContext arguments reversed do: [ :each | 
 
- 		anInterpreter push: each ].
 
- 		
 
- 	anInterpreter push: (self innerContext receiver)
 
- !
 
- supercall
 
- 	^ supercall ifNil: [ false ]
 
- !
 
- supercall: aBoolean
 
- 	supercall := aBoolean
 
- ! !
 
- !AIContext methodsFor: 'private'!
 
- basicLocalAt: aString
 
- 	^ self locals at: aString
 
- !
 
- basicLocalAt: aString put: anObject
 
- 	self locals at: aString put: anObject
 
- !
 
- lookupContextForLocal: aString
 
- 	"Lookup the context defining the local named `aString` 
 
- 	up to the method context"
 
- 	^ self 
 
- 		lookupContextForLocal: aString 
 
- 		ifNone: [ self variableNotFound ]
 
- !
 
- lookupContextForLocal: aString ifNone: aBlock
 
- 	"Lookup the context defining the local named `aString` 
 
- 	up to the method context"
 
- 	^ self locals 
 
- 		at: aString
 
- 		ifPresent: [ self ]
 
- 		ifAbsent: [ 
 
- 			self outerContext 
 
- 				ifNil: aBlock
 
- 				ifNotNil: [ :context | 
 
- 					context lookupContextForLocal: aString ifNone: aBlock ] ]
 
- ! !
 
- !AIContext methodsFor: 'testing'!
 
- isTopContext
 
- 	^ self innerContext isNil
 
- ! !
 
- !AIContext class methodsFor: 'instance creation'!
 
- fromMethodContext: aMethodContext
 
- 	^ self new
 
- 		initializeFromMethodContext: aMethodContext;
 
- 		yourself
 
- ! !
 
- SemanticAnalyzer subclass: #AISemanticAnalyzer
 
- 	slots: {#context}
 
- 	package: 'Compiler-Interpreter'!
 
- !AISemanticAnalyzer commentStamp!
 
- I perform the same semantic analysis than `SemanticAnalyzer`, with the difference that provided an `AIContext` context, variables are bound with the context variables.!
 
- !AISemanticAnalyzer methodsFor: 'accessing'!
 
- context
 
- 	^ context
 
- !
 
- context: anAIContext
 
- 	context := anAIContext
 
- ! !
 
- !AISemanticAnalyzer methodsFor: 'visiting'!
 
- visitVariableNode: aNode
 
- 	self context 
 
- 		localAt: aNode identifier 
 
- 		ifAbsent: [ ^ super visitVariableNode: aNode ].
 
- 	aNode binding: ASTContextVar new
 
- ! !
 
- ScopeVar subclass: #ASTContextVar
 
- 	slots: {#context}
 
- 	package: 'Compiler-Interpreter'!
 
- !ASTContextVar commentStamp!
 
- I am a variable defined in a `context`.!
 
- !ASTContextVar methodsFor: 'accessing'!
 
- context
 
- 	^ context
 
- !
 
- context: anObject
 
- 	context := anObject
 
- ! !
 
- Object subclass: #ASTDebugger
 
- 	slots: {#interpreter. #context. #result}
 
- 	package: 'Compiler-Interpreter'!
 
- !ASTDebugger commentStamp!
 
- I am a stepping debugger interface for Amber code.
 
- I internally use an instance of `ASTInterpreter` to actually step through node and interpret them.
 
- My instances are created from an `AIContext` 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
 
- 	^ self context ifNotNil: [ :ctx | 
 
- 		ctx interpreter ]
 
- !
 
- node
 
- 	^ self interpreter ifNotNil: [
 
- 		self interpreter node ]
 
- !
 
- result
 
- 	^ result
 
- ! !
 
- !ASTDebugger methodsFor: 'actions'!
 
- flushInnerContexts
 
- 	"When stepping, the inner contexts are not relevent anymore,
 
- 	and can be flushed"
 
- 	
 
- 	self context ifNotNil: [ :cxt | 
 
- 		cxt innerContext: nil ]
 
- ! !
 
- !ASTDebugger methodsFor: 'private'!
 
- onStep
 
- 	"After each step, check if the interpreter is at the end,
 
- 	and if it is move to its outer context if any, skipping its 
 
- 	current node (which was just evaluated by the current 
 
- 	interpreter).
 
- 	
 
- 	After each step we also flush inner contexts."
 
- 	
 
- 	result := self interpreter result.
 
- 	
 
- 	self interpreter atEnd ifTrue: [
 
- 		self context outerContext ifNotNil: [ :outerContext | 
 
- 			self context: outerContext ].
 
- 		self interpreter atEnd ifFalse: [ self interpreter skip ] ].
 
- 		
 
- 	self flushInnerContexts
 
- ! !
 
- !ASTDebugger methodsFor: 'stepping'!
 
- proceed
 
- 	[ self atEnd ] whileFalse: [ self stepOver ]
 
- !
 
- restart
 
- 	self interpreter restart.
 
- 	self flushInnerContexts
 
- !
 
- stepInto
 
- 	self shouldBeImplemented
 
- !
 
- stepOver
 
- 	self context isTopContext 
 
- 		ifFalse: [ self interpreter skip ]
 
- 		ifTrue: [ self interpreter stepOver ].
 
- 	self onStep
 
- ! !
 
- !ASTDebugger methodsFor: 'testing'!
 
- atEnd	
 
- 	self context ifNil: [ ^ true ].
 
- 	
 
- 	^ self interpreter atEnd and: [ 
 
- 		self context isTopContext ]
 
- ! !
 
- !ASTDebugger class methodsFor: 'instance creation'!
 
- context: aContext
 
- 	^ self new
 
- 		context: aContext;
 
- 		yourself
 
- ! !
 
- NodeVisitor subclass: #ASTEnterNode
 
- 	slots: {#interpreter}
 
- 	package: 'Compiler-Interpreter'!
 
- !ASTEnterNode methodsFor: 'accessing'!
 
- interpreter
 
- 	^ interpreter
 
- !
 
- interpreter: anObject
 
- 	interpreter := anObject
 
- ! !
 
- !ASTEnterNode methodsFor: 'visiting'!
 
- visitBlockNode: aNode
 
- 	"Answer the node as we want to avoid eager evaluation"
 
- 	
 
- 	^ aNode
 
- !
 
- visitDagNode: aNode
 
- 	^ aNode dagChildren
 
- 		ifEmpty: [ aNode ]
 
- 		ifNotEmpty: [ :nodes | self visit: nodes first ]
 
- !
 
- visitSequenceNode: aNode
 
- 	aNode temps do: [ :each |
 
- 		self interpreter context defineLocal: each ].
 
- 	^ super visitSequenceNode: aNode
 
- ! !
 
- !ASTEnterNode class methodsFor: 'instance creation'!
 
- on: anInterpreter
 
- 	^ self new
 
- 		interpreter: anInterpreter;
 
- 		yourself
 
- ! !
 
- NodeVisitor subclass: #ASTInterpreter
 
- 	slots: {#node. #context. #stack. #returnValue. #returned. #forceAtEnd}
 
- 	package: 'Compiler-Interpreter'!
 
- !ASTInterpreter commentStamp!
 
- I visit an AST, interpreting (evaluating) nodes one after the other, using a small stack machine.
 
- ## API
 
- While my instances should be used from within an `ASTDebugger`, which provides a more high level interface,
 
- you can use methods from the `interpreting` protocol:
 
- - `#step` evaluates the current `node` only
 
- - `#stepOver` evaluates the AST from the current `node` up to the next stepping node (most likely the next send node)
 
- - `#proceed` evaluates eagerly the AST
 
- - `#restart` select the first node of the AST
 
- - `#skip` skips the current node, moving to the next one if any!
 
- !ASTInterpreter methodsFor: 'accessing'!
 
- context
 
- 	^ context
 
- !
 
- context: aContext
 
- 	context := aContext
 
- !
 
- node
 
- 	"Answer the next node, ie the node to be evaluated in the next step"
 
- 	
 
- 	^ node
 
- !
 
- node: aNode
 
- 	node := aNode
 
- !
 
- result
 
- 	^ self hasReturned 
 
- 		ifTrue: [ self returnValue ] 
 
- 		ifFalse: [ self context receiver ]
 
- !
 
- returnValue
 
- 	^ returnValue
 
- !
 
- returnValue: anObject
 
- 	returnValue := anObject
 
- !
 
- stack
 
- 	^ stack ifNil: [ stack := OrderedCollection new ]
 
- ! !
 
- !ASTInterpreter methodsFor: 'initialization'!
 
- initialize
 
- 	super initialize.
 
- 	forceAtEnd := false
 
- ! !
 
- !ASTInterpreter methodsFor: 'interpreting'!
 
- enterNode
 
- 	self node: ((ASTEnterNode on: self) visit: self node)
 
- !
 
- interpret
 
- 	"Interpret the next node to be evaluated"
 
- 	
 
- 	self visit: self node
 
- !
 
- next
 
- 	| nd parent |
 
- 	nd := self node.
 
- 	parent := nd parent.
 
- 	(parent ifNotNil: [ parent nextSiblingNode: nd ])
 
- 		ifNil: [ self node: parent ]
 
- 		ifNotNil: [ :sibling | self node: sibling; enterNode ]
 
- !
 
- proceed
 
- 	"Eagerly evaluate the ast"
 
- 	
 
- 	[ self atEnd ] 
 
- 		whileFalse: [ self step ]
 
- !
 
- restart
 
- 	self node: self context ast; enterNode
 
- !
 
- setNonLocalReturnFromContext: aContext
 
- 	aContext interpreter hasReturned ifTrue: [
 
- 		returned := true.
 
- 		self returnValue: aContext interpreter returnValue ]
 
- !
 
- skip
 
- 	self next
 
- !
 
- step
 
- 	self 
 
- 		interpret; 
 
- 		next
 
- !
 
- stepOver
 
- 	self step.
 
- 	
 
- 	[ self node isNil or: [ self node isSteppingNode ] ] whileFalse: [ 
 
- 		self step ]
 
- ! !
 
- !ASTInterpreter methodsFor: 'private'!
 
- assign: aNode to: anObject
 
- 	aNode binding inContext: self context put: anObject
 
- !
 
- eval: aString
 
- 	"Evaluate aString as JS source inside an JS function.
 
- 	aString is not sandboxed."
 
- 	
 
- 	| source function |
 
- 	
 
- 	source := String streamContents: [ :str |
 
- 		str nextPutAll: '0,(function('.
 
- 		self context locals keys
 
- 			do: [ :each | str nextPutAll: each ]
 
- 			separatedBy: [ str nextPutAll: ',' ].
 
- 		str
 
- 			nextPutAll: '){ return (function() {';
 
- 			nextPutAll: aString;
 
- 			nextPutAll: '})()})' ].
 
- 			
 
- 	function := Compiler eval: source.
 
- 	
 
- 	^ function valueWithPossibleArguments: self context locals values
 
- !
 
- messageFromSendNode: aSendNode arguments: anArray
 
- 	^ Message selector: aSendNode selector arguments: anArray
 
- !
 
- messageNotUnderstood: aMessage receiver: anObject
 
- 	MessageNotUnderstood new
 
- 		message: aMessage;
 
- 		receiver: anObject;
 
- 		signal
 
- !
 
- sendJavaScript: aString superMessage: aMessage switcher: aJSFunction to: anObject
 
- 	| methodBlock parent |
 
- 	
 
- 	parent := self context method methodClass superPrototype.
 
- 	parent ifNil: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
 
- 	
 
- 	methodBlock := (parent at: aString)
 
- 		ifNil: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
 
- 		
 
- 	^ methodBlock applyTo: anObject arguments: (aJSFunction applyTo: nil arguments: aMessage arguments)
 
- !
 
- sendJavaScript: aString superMessage: aMessage to: anObject
 
- 	| methodBlock parent |
 
- 	
 
- 	parent := self context method methodClass superPrototype.
 
- 	parent ifNil: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
 
- 	
 
- 	methodBlock := (parent at: aString)
 
- 		ifNil: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
 
- 		
 
- 	^ methodBlock applyTo: anObject arguments: aMessage arguments
 
- !
 
- sendSuperMessage: aMessage to: anObject
 
- 	| method parent |
 
- 	
 
- 	parent := self context method methodClass superclass.
 
- 	parent ifNil: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
 
- 	
 
- 	method := (parent lookupSelector: aMessage selector)
 
- 		ifNil: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
 
- 		
 
- 	^ method sendTo: anObject arguments: aMessage arguments
 
- ! !
 
- !ASTInterpreter methodsFor: 'stack'!
 
- peek
 
- 	"Peek the top object of the context stack"
 
- 	
 
- 	self stack ifEmpty: [ ^ nil ].
 
- 	
 
- 	^ self stack last
 
- !
 
- pop
 
- 	"Pop an object from the context stack"
 
- 	
 
- 	| peekedValue |
 
- 	
 
- 	peekedValue := self peek.
 
- 	self stack removeLast.
 
- 	^ peekedValue
 
- !
 
- push: anObject
 
- 	"Push an object to the context stack"
 
- 	
 
- 	^ self stack add: anObject
 
- ! !
 
- !ASTInterpreter methodsFor: 'testing'!
 
- atEnd
 
- 	^ forceAtEnd or: [ self hasReturned or: [ self node isNil ] ]
 
- !
 
- hasReturned
 
- 	^ returned ifNil: [ false ]
 
- ! !
 
- !ASTInterpreter methodsFor: 'visiting'!
 
- visit: aNode
 
- 	self hasReturned ifFalse: [ super visit: aNode ]
 
- !
 
- visitAssignmentNode: aNode
 
- 	| poppedValue |
 
- 	
 
- 	poppedValue := self pop.
 
- 	
 
- 	"Pop the left side of the assignment.
 
- 	It already has been visited, and we don't need its value."
 
- 	self pop.
 
- 	
 
- 	self push: poppedValue.
 
- 	self assign: aNode left to: poppedValue
 
- !
 
- visitBlockNode: aNode
 
- 	"Do not evaluate the block node.
 
- 	Instead, put all instructions into a block that we push to the stack for later evaluation"
 
- 	
 
- 	| block |
 
- 	
 
- 	block := AIBlockClosure forContext: self context node: aNode.
 
- 	
 
- 	self push: block
 
- !
 
- visitBlockSequenceNode: aNode
 
- 	"If the receiver is actually visiting a BlockSequenceNode,
 
- 	it means the the context is a block context. Evaluation should 
 
- 	stop right after evaluating the block sequence and the outer
 
- 	context's interpreter should take over. 
 
- 	Therefore we force #atEnd."
 
- 	
 
- 	super visitBlockSequenceNode: aNode.
 
- 	forceAtEnd := true
 
- !
 
- visitDagNode: aNode
 
- 	"Do nothing by default. Especially, do not visit children recursively."
 
- !
 
- visitDynamicArrayNode: aNode
 
- 	| array |
 
- 	
 
- 	array := #().
 
- 	aNode dagChildren do: [ :each |
 
- 		array addFirst: self pop ].
 
- 	
 
- 	self push: array
 
- !
 
- visitDynamicDictionaryNode: aNode
 
- 	| keyValueList |
 
- 	
 
- 	keyValueList := OrderedCollection new.
 
- 	
 
- 	aNode dagChildren do: [ :each | 
 
- 		keyValueList add: self pop ].
 
- 	
 
- 	self push: (HashedCollection newFromPairs: keyValueList reversed)
 
- !
 
- visitJSStatementNode: aNode
 
- 	returned := true.
 
- 	self returnValue: (self eval: aNode source)
 
- !
 
- visitReturnNode: aNode
 
- 	returned := true.
 
- 	self returnValue: self pop
 
- !
 
- visitSendNode: aNode
 
- 	| receiver args message result |
 
- 	
 
- 	args := aNode arguments collect: [ :each | self pop ].
 
- 	receiver := self peek.
 
- 	
 
- 	message := self
 
- 		messageFromSendNode: aNode
 
- 		arguments: args reversed.
 
- 	
 
- 	result := aNode superSend
 
- 		ifFalse: [ message sendTo: receiver ]
 
- 		ifTrue: [ aNode receiver binding isJavaScriptSuper
 
- 			ifFalse: [ self sendSuperMessage: message to: receiver ]
 
- 			ifTrue: [ aNode argumentSwitcher
 
- 				ifNil: [ self sendJavaScript: aNode javaScriptSelector superMessage: message to: receiver ]
 
- 				ifNotNil: [ :switcher | self sendJavaScript: aNode javaScriptSelector superMessage: message switcher: switcher to: receiver ] ] ].
 
- 	
 
- 	"For cascade sends, push the reciever if the send is not the last one"
 
- 	aNode isSideEffect ifFalse: [ self pop; push: result ]
 
- !
 
- visitValueNode: aNode
 
- 	self push: aNode value
 
- !
 
- visitVariableNode: aNode
 
- 	self push: (aNode binding inContext: self context)
 
- ! !
 
- Error subclass: #ASTInterpreterError
 
- 	slots: {}
 
- 	package: 'Compiler-Interpreter'!
 
- !ASTInterpreterError commentStamp!
 
- I get signaled when an AST interpreter is unable to interpret a node.!
 
- NodeVisitor subclass: #ASTPCNodeVisitor
 
- 	slots: {#index. #trackedIndex. #selector. #currentNode}
 
- 	package: 'Compiler-Interpreter'!
 
- !ASTPCNodeVisitor commentStamp!
 
- I visit an AST until I get to the current node for the `context` and answer it.
 
- ## API
 
- My instances must be filled with a context object using `#context:`.
 
- After visiting the AST the current node is answered by `#currentNode`!
 
- !ASTPCNodeVisitor methodsFor: 'accessing'!
 
- currentNode
 
- 	^ currentNode
 
- !
 
- increaseTrackedIndex
 
- 	trackedIndex := self trackedIndex + 1
 
- !
 
- index
 
- 	^ index
 
- !
 
- index: aNumber
 
- 	index := aNumber
 
- !
 
- selector
 
- 	^ selector
 
- !
 
- selector: aString
 
- 	selector := aString
 
- !
 
- trackedIndex
 
- 	^ trackedIndex ifNil: [ trackedIndex := 0 ]
 
- ! !
 
- !ASTPCNodeVisitor methodsFor: 'visiting'!
 
- visitJSStatementNode: aNode
 
- 	"If a JSStatementNode is encountered, it always is the current node.
 
- 	Stop visiting the AST there"
 
- 	
 
- 	currentNode := aNode
 
- !
 
- visitSendNode: aNode
 
- 	super visitSendNode: aNode.
 
- 	
 
- 	self selector = aNode selector ifTrue: [
 
- 		self trackedIndex = self index ifTrue: [ currentNode := aNode ].
 
- 		self increaseTrackedIndex ]
 
- ! !
 
- AIContext setTraitComposition: {TMethodContext} asTraitComposition!
 
- ! !
 
- !ASTNode methodsFor: '*Compiler-Interpreter'!
 
- isSteppingNode
 
- 	^ false
 
- !
 
- nextSiblingNode: aNode
 
- 	"Answer the next node after aNode or nil"
 
- 	
 
- 	^ self dagChildren 
 
- 		at: (self dagChildren indexOf: aNode) + 1
 
- 		ifAbsent: [ nil ]
 
- ! !
 
- !AliasVar methodsFor: '*Compiler-Interpreter'!
 
- inContext: aContext
 
- 	self error: 'Alias variable is internal, it should never appear in normal variable context.'
 
- ! !
 
- !AssignmentNode methodsFor: '*Compiler-Interpreter'!
 
- isSteppingNode
 
- 	^ true
 
- ! !
 
- !BlockNode methodsFor: '*Compiler-Interpreter'!
 
- isSteppingNode
 
- 	^ true
 
- !
 
- nextSiblingNode: aNode
 
- 	"Answer nil as we want to avoid eager evaluation"
 
- 	
 
- 	"In fact, this should not have been called, ever. IMO. -- herby"
 
- 	
 
- 	^ nil
 
- ! !
 
- !ClassRefVar methodsFor: '*Compiler-Interpreter'!
 
- inContext: aContext
 
- 	^ Smalltalk globals 
 
- 		at: self name 
 
- 		ifAbsent: [ Platform globals at: self name ]
 
- ! !
 
- !DynamicArrayNode methodsFor: '*Compiler-Interpreter'!
 
- isSteppingNode
 
- 	^ true
 
- ! !
 
- !DynamicDictionaryNode methodsFor: '*Compiler-Interpreter'!
 
- isSteppingNode
 
- 	^ true
 
- ! !
 
- !Evaluator methodsFor: '*Compiler-Interpreter'!
 
- evaluate: aString context: aContext
 
- 	"Similar to #evaluate:for:, with the following differences:
 
- 	- instead of compiling and running `aString`, `aString` is interpreted using an `ASTInterpreter`
 
- 	- instead of evaluating against a receiver, evaluate in the context of `aContext`"
 
- 	| compiler ast |
 
- 	
 
- 	compiler := Compiler new.
 
- 	[ ast := compiler parseExpression: aString ] 
 
- 		on: Error 
 
- 		do: [ :ex | ^ Terminal alert: ex messageText ].
 
- 		
 
- 	(AISemanticAnalyzer on: aContext receiver class)
 
- 		context: aContext;
 
- 		visit: ast.
 
- 	^ aContext evaluateNode: ast
 
- ! !
 
- !ExternallyKnownVar methodsFor: '*Compiler-Interpreter'!
 
- inContext: aContext
 
- 	^ Platform globals at: self name ifAbsent: [ self error: 'Unknown variable' ]
 
- ! !
 
- !JSStatementNode methodsFor: '*Compiler-Interpreter'!
 
- isSteppingNode
 
- 	^ true
 
- ! !
 
- !JavaScriptSuperVar methodsFor: '*Compiler-Interpreter'!
 
- isJavaScriptSuper
 
- 	^ true
 
- ! !
 
- !PseudoVar methodsFor: '*Compiler-Interpreter'!
 
- inContext: aContext
 
- 	^ #{'nil'->nil. 'true'->true. 'false'->false}
 
- 		at: self name
 
- 		ifAbsent: [ super inContext: aContext ]
 
- ! !
 
- !ScopeVar methodsFor: '*Compiler-Interpreter'!
 
- inContext: aContext
 
- 	^ aContext localAt: self name
 
- !
 
- inContext: aContext put: anObject
 
- 	self error: 'Non-assignable variables should not be changed.'
 
- ! !
 
- !SendNode methodsFor: '*Compiler-Interpreter'!
 
- isSteppingNode
 
- 	^ true
 
- ! !
 
- !SlotVar methodsFor: '*Compiler-Interpreter'!
 
- inContext: aContext
 
- 	^ aContext receiver instVarNamed: self name
 
- !
 
- inContext: aContext put: anObject
 
- 	aContext receiver instVarNamed: self name put: anObject
 
- ! !
 
- !SuperVar methodsFor: '*Compiler-Interpreter'!
 
- inContext: aContext
 
- 	^ aContext localAt: 'self'
 
- !
 
- isJavaScriptSuper
 
- 	^ false
 
- ! !
 
- !TempVar methodsFor: '*Compiler-Interpreter'!
 
- inContext: aContext put: anObject
 
- 	aContext localAt: self name put: anObject
 
- ! !
 
 
  |