1
0
فهرست منبع

Make new `Compiler.st` for Makefile.

(not sure that it's needed, but it had wrong exporter,
so it is generated from fresh code)
Herbert Vojčík 12 سال پیش
والد
کامیت
859a6188ea
1فایلهای تغییر یافته به همراه651 افزوده شده و 117 حذف شده
  1. 651 117
      st/Compiler.st

+ 651 - 117
st/Compiler.st

@@ -155,8 +155,8 @@ exportMethodsOf: aClass on: aStream
 exportPackageDefinitionOf: package on: aStream
 	aStream 
 	    nextPutAll: 'smalltalk.addPackage(';
-	    nextPutAll: '''', package name, ''', ', package propertiesAsJSON , ');'.
-	aStream lf
+	    nextPutAll: '''', package name, ''');';
+        lf
 !
 
 exportPackageExtensionsOf: package on: aStream
@@ -262,8 +262,8 @@ exportPackageDefinitionOf: package on: aStream
 	"Chunk format."
 
 	aStream 
-	    nextPutAll: 'Smalltalk current createPackage: ''', package name,
-		''' properties: ', package properties storeString, '!!'; lf.
+		nextPutAll: 'Smalltalk current createPackage: ''', package name, '''!!';
+		lf
 !
 
 exportPackageExtensionsOf: package on: aStream
@@ -313,7 +313,8 @@ exportMethod: aMethod of: aClass on: aStream
 		nextPutAll: aMethod selector asSelector asJavascript, ',';lf;
 		nextPutAll: 'smalltalk.method({';lf;
 		nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
-		nextPutAll: 'fn: ', aMethod fn compiledSource;lf;
+		nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
+		nextPutAll: 'messageSends: ', aMethod messageSends asJavascript;
 		nextPutAll: '}),';lf;
 		nextPutAll: 'smalltalk.', (self classNameFor: aClass);
 		nextPutAll: ');';lf;lf
@@ -459,6 +460,10 @@ The default behavior is to allow it, as this is how Amber currently is able to s
 
 !UnknownVariableError methodsFor: '*Compiler'!
 
+messageText
+	^ 'Unknown Variable error: ', self variableName, ' is not defined'
+!
+
 variableName
 	^ variableName
 !
@@ -467,6 +472,25 @@ variableName: aString
 	variableName := aString
 ! !
 
+ErrorHandler subclass: #RethrowErrorHandler
+	instanceVariableNames: ''
+	package:'Compiler'!
+!RethrowErrorHandler commentStamp!
+This class is used in the commandline version of the compiler.
+It uses the handleError: message of ErrorHandler for printing the stacktrace and throws the error again as JS exception.
+As a result Smalltalk errors are not swallowd by the Amber runtime and compilation can be aborted.!
+
+!RethrowErrorHandler methodsFor: '*Compiler'!
+
+basicSignal: anError
+	<throw anError>
+!
+
+handleError: anError
+	super handleError: anError.
+    self basicSignal: anError
+! !
+
 Object subclass: #Compiler
 	instanceVariableNames: 'currentClass source unknownVariables codeGeneratorClass'
 	package:'Compiler'!
@@ -553,12 +577,10 @@ evaluateExpression: aString
 !
 
 install: aString forClass: aBehavior category: anotherString
-	| compiled |
-	compiled := self eval: (self compile: aString forClass: aBehavior).
-	compiled category: anotherString.
-	aBehavior addCompiledMethod: compiled.
-    self setupClass: aBehavior.
-	^compiled
+   	^ ClassBuilder new
+    	installMethod: (self eval: (self compile: aString forClass: aBehavior))
+        forClass: aBehavior
+        category: anotherString
 !
 
 parse: aString
@@ -573,7 +595,7 @@ recompile: aClass
 	aClass methodDictionary do: [:each |
 		console log: aClass name, ' >> ', each selector.
 		self install: each source forClass: aClass category: each category].
-	self setupClass: aClass.
+	"self setupClass: aClass."
 	aClass isMetaclass ifFalse: [self recompile: aClass class]
 !
 
@@ -581,10 +603,6 @@ recompileAll
 	Smalltalk current classes do: [:each |
 		Transcript show: each; cr.
 		[self recompile: each] valueWithTimeout: 100]
-!
-
-setupClass: aClass
-	<smalltalk.init(aClass)>
 ! !
 
 !Compiler class methodsFor: '*Compiler'!
@@ -617,7 +635,7 @@ visit: aNode
 !
 
 visitAll: aCollection
-	^ aCollection do: [ :each | self visit: each ]
+	^ aCollection collect: [ :each | self visit: each ]
 !
 
 visitAssignmentNode: aNode
@@ -828,6 +846,10 @@ isImmutable
 	^false
 !
 
+isNode
+	^ true
+!
+
 isReturnNode
 	^false
 !
@@ -915,6 +937,10 @@ scope: aLexicalScope
 
 isBlockNode
 	^true
+!
+
+subtreeNeedsAliasing
+    ^ self shouldBeAliased or: [ self shouldBeInlined ]
 ! !
 
 !BlockNode methodsFor: '*Compiler'!
@@ -1303,6 +1329,12 @@ accept: aVisitor
 	^ aVisitor visitClassReferenceNode: self
 ! !
 
+!Object methodsFor: '*Compiler'!
+
+isNode
+	^ false
+! !
+
 Object subclass: #LexicalScope
 	instanceVariableNames: 'node instruction temps args outerScope'
 	package:'Compiler'!
@@ -1663,12 +1695,6 @@ I am an temporary variable of a method or block.!
 
 !TempVar methodsFor: '*Compiler'!
 
-alias
-	^ self scope alias, '.locals.', super alias
-! !
-
-!TempVar methodsFor: '*Compiler'!
-
 isTempVar
 	^ true
 ! !
@@ -1722,16 +1748,24 @@ errorShadowingVariable: aString
 !
 
 errorUnknownVariable: aNode
-	"Throw an error if the variable is undeclared in the global JS scope (i.e. window)"
+	"Throw an error if the variable is undeclared in the global JS scope (i.e. window).
+    We allow four variable names in addition: `jQuery`, `window`, `process` and `global` 
+    for nodejs and browser environments. 
+    
+    This is only to make sure compilation works on both browser-based and nodejs environments.
+    The ideal solution would be to use a pragma instead"
 
 	| identifier |
     identifier := aNode value.
-	((#('jQuery' 'window' 'process' 'global') includes: identifier) not and: [ self isVariableGloballyUndefined: identifier ]) ifTrue: [
-			UnknownVariableError new
-				variableName: aNode value;
-				signal ]
-		ifFalse: [
-			currentScope methodScope unknownVariables add: aNode value. ]
+    
+	((#('jQuery' 'window' 'document' 'process' 'global') includes: identifier) not 
+        and: [ self isVariableGloballyUndefined: identifier ]) 
+        	ifTrue: [
+				UnknownVariableError new
+					variableName: aNode value;
+					signal ]
+			ifFalse: [
+				currentScope methodScope unknownVariables add: aNode value ]
 ! !
 
 !SemanticAnalyzer methodsFor: '*Compiler'!
@@ -2148,6 +2182,10 @@ instructions
 	^ instructions ifNil: [ instructions := OrderedCollection new ]
 !
 
+method
+	^ self parent method
+!
+
 parent
 	^ parent
 !
@@ -2200,6 +2238,10 @@ isLocalReturn
 	^ false
 !
 
+isMethod
+	^ false
+!
+
 isReturn
 	^ false
 !
@@ -2278,11 +2320,11 @@ scope: aScope
 	scope := aScope
 ! !
 
-IRScopedInstruction subclass: #IRClosure
+IRScopedInstruction subclass: #IRClosureInstruction
 	instanceVariableNames: 'arguments'
 	package:'Compiler'!
 
-!IRClosure methodsFor: '*Compiler'!
+!IRClosureInstruction methodsFor: '*Compiler'!
 
 arguments
 	^ arguments ifNil: [ #() ]
@@ -2292,11 +2334,28 @@ arguments: aCollection
 	arguments := aCollection
 !
 
+locals
+	^ self arguments copy
+    	addAll: (self tempDeclarations collect: [ :each | each name ]); 
+        yourself
+!
+
 scope: aScope
 	super scope: aScope.
 	aScope instruction: self
 !
 
+tempDeclarations
+	^ self instructions select: [ :each | 
+    	each isTempDeclaration ]
+! !
+
+IRClosureInstruction subclass: #IRClosure
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!IRClosure methodsFor: '*Compiler'!
+
 sequence
 	^ self instructions last
 ! !
@@ -2313,22 +2372,14 @@ accept: aVisitor
 	^ aVisitor visitIRClosure: self
 ! !
 
-IRScopedInstruction subclass: #IRMethod
-	instanceVariableNames: 'theClass source selector classReferences messageSends superSends arguments internalVariables'
+IRClosureInstruction subclass: #IRMethod
+	instanceVariableNames: 'theClass source selector classReferences messageSends superSends internalVariables'
 	package:'Compiler'!
 !IRMethod commentStamp!
 I am a method instruction!
 
 !IRMethod methodsFor: '*Compiler'!
 
-arguments
-	^ arguments
-!
-
-arguments: aCollection
-	arguments := aCollection
-!
-
 classReferences
 	^ classReferences
 !
@@ -2341,6 +2392,10 @@ internalVariables
 	^ internalVariables ifNil: [ internalVariables := Set new ]
 !
 
+isMethod
+	^ true
+!
+
 messageSends
 	^ messageSends
 !
@@ -2349,9 +2404,8 @@ messageSends: aCollection
 	messageSends := aCollection
 !
 
-scope: aScope
-	super scope: aScope.
-	aScope instruction: self
+method
+	^ self
 !
 
 selector
@@ -2481,6 +2535,12 @@ name: aString
 
 !IRTempDeclaration methodsFor: '*Compiler'!
 
+isTempDeclaration
+	^ true
+! !
+
+!IRTempDeclaration methodsFor: '*Compiler'!
+
 accept: aVisitor
 	^ aVisitor visitIRTempDeclaration: self
 ! !
@@ -2754,6 +2814,8 @@ visitIRAssignment: anIRAssignment
 visitIRClosure: anIRClosure
 	self stream 
 		nextPutClosureWith: [ 
+        	self stream nextPutVars: (anIRClosure tempDeclarations collect: [ :each |
+    				each name asVariableName ]).
         	self stream 
             	nextPutBlockContextFor: anIRClosure
                 during: [ super visitIRClosure: anIRClosure ] ]
@@ -2777,10 +2839,13 @@ visitIRDynamicDictionary: anIRDynamicDictionary
 !
 
 visitIRMethod: anIRMethod
+
 	self stream
 		nextPutMethodDeclaration: anIRMethod 
 		with: [ self stream 
 			nextPutFunctionWith: [ 
+            	self stream nextPutVars: (anIRMethod tempDeclarations collect: [ :each |
+    				each name asVariableName ]).
             	self stream nextPutContextFor: anIRMethod during: [
 				anIRMethod internalVariables notEmpty ifTrue: [
 					self stream nextPutVars: (anIRMethod internalVariables asArray collect: [ :each |
@@ -2833,9 +2898,9 @@ visitIRSequence: anIRSequence
 !
 
 visitIRTempDeclaration: anIRTempDeclaration
-	self stream 
-    	nextPutAll: anIRTempDeclaration scope alias, '.locals.', anIRTempDeclaration name, '=nil;'; 
-        lf
+	"self stream 
+    	nextPutAll: 'var ', anIRTempDeclaration name asVariableName, ';'; 
+        lf"
 !
 
 visitIRValue: anIRValue
@@ -2890,10 +2955,26 @@ nextPutAssignment
 
 nextPutBlockContextFor: anIRClosure during: aBlock
 	self 
-    	nextPutAll: 'return smalltalk.withContext(function(', anIRClosure scope alias, ') { '; 
+    	nextPutAll: 'return smalltalk.withContext(function(', anIRClosure scope alias, ') {'; 
         nextPutAll: String cr.
+    
     aBlock value.
-    self nextPutAll: '})'
+    
+    self 
+    	nextPutAll: '}, function(', anIRClosure scope alias, ') {';
+        nextPutAll: anIRClosure scope alias, '.fillBlock({'.
+    
+    anIRClosure locals 
+    	do: [ :each |
+    		self 
+        		nextPutAll: each asVariableName;
+           	 	nextPutAll: ':';
+        		nextPutAll: each asVariableName]
+		separatedBy: [ self nextPutAll: ',' ].
+    
+    self
+    	nextPutAll: '},';
+        nextPutAll:  anIRClosure method scope alias, ')})'
 !
 
 nextPutClosureWith: aBlock arguments: anArray
@@ -2911,15 +2992,23 @@ nextPutContextFor: aMethod during: aBlock
     	nextPutAll: 'return smalltalk.withContext(function(', aMethod scope alias, ') { '; 
         nextPutAll: String cr.
     aBlock value.
+    
     self 
-    	nextPutAll: '}, self, ';
-        nextPutAll: aMethod selector asJavascript, ', ['.
-    aMethod arguments 
-    	do: [ :each | self nextPutAll: each asVariableName ]
-      	separatedBy: [ self nextPutAll: ','  ].
-    self nextPutAll: '], ';
+    	nextPutAll: '}, function(', aMethod scope alias, ') {', aMethod scope alias; 
+        nextPutAll: '.fill(self,', aMethod selector asJavascript, ',{'.
+
+    aMethod locals 
+    	do: [ :each |
+    		self 
+        		nextPutAll: each asVariableName;
+           	 	nextPutAll: ':';
+        		nextPutAll: each asVariableName]
+		separatedBy: [ self nextPutAll: ',' ].
+    
+    self
+    	nextPutAll: '}, ';
         nextPutAll: aMethod theClass asJavascript;
-        nextPutAll: ')'
+        nextPutAll: ')})'
 !
 
 nextPutFunctionWith: aBlock arguments: anArray
@@ -3019,6 +3108,8 @@ nextPutVar: aString
 !
 
 nextPutVars: aCollection
+	aCollection ifEmpty: [ ^self ].
+    
 	stream nextPutAll: 'var '.
 	aCollection 
 		do: [ :each | stream nextPutAll: each ]
@@ -3690,25 +3781,36 @@ irTranslator
 ! !
 
 NodeVisitor subclass: #AIContext
-	instanceVariableNames: 'outerContext pc locals receiver selector'
+	instanceVariableNames: 'outerContext pc locals method'
 	package:'Compiler'!
+!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: '*Compiler'!
 
-initializeFromMethodContext: aMethodContext
-	self pc: aMethodContext pc.
-    self receiver: aMethodContext receiver.
-    self selector: aMethodContext selector.
-    aMethodContext outerContext ifNotNil: [
-		self outerContext: (self class fromMethodContext: aMethodContext outerContext) ].
-    aMethodContext locals keysAndValuesDo: [ :key :value |
-    	self locals at: key put: value ]
+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
 !
@@ -3726,41 +3828,177 @@ pc: anInteger
 !
 
 receiver
-	^ receiver
+	^ self localAt: 'self'
 !
 
 receiver: anObject
-	receiver := anObject
+	self localAt: 'self' put: anObject
 !
 
 selector
-	^ selector
-!
+	^ self metod
+    	ifNotNil: [ self method selector ]
+! !
 
-selector: aString
-	selector := aString
+!AIContext methodsFor: '*Compiler'!
+
+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: '*Compiler'!
 
 fromMethodContext: aMethodContext
-	^ self new 
+	^ self new
     	initializeFromMethodContext: aMethodContext;
         yourself
 ! !
 
-NodeVisitor subclass: #ASTInterpreter
-	instanceVariableNames: 'currentNode context shouldReturn'
+Object subclass: #ASTDebugger
+	instanceVariableNames: 'interpreter context'
 	package:'Compiler'!
+!ASTDebugger commentStamp!
+ASTDebugger is a debugger to Amber.
+It uses an AST interpreter to step through the code.
 
-!ASTInterpreter methodsFor: '*Compiler'!
+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: '*Compiler'!
 
 context
 	^ context
 !
 
+context: aContext
+	context := AIContext new.
+!
+
+interpreter
+	^ interpreter ifNil: [ interpreter := self defaultInterpreterClass new ]
+!
+
+interpreter: anInterpreter
+	interpreter := anInterpreter
+!
+
+method
+	^ self context method
+! !
+
+!ASTDebugger methodsFor: '*Compiler'!
+
+defaultInterpreterClass
+	^ ASTSteppingInterpreter
+! !
+
+!ASTDebugger methodsFor: '*Compiler'!
+
+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: '*Compiler'!
+
+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: '*Compiler'!
+
+context: aMethodContext
+	^ self new
+    	initializeWithContext: aMethodContext;
+        yourself
+! !
+
+Object subclass: #ASTInterpreter
+	instanceVariableNames: 'currentNode context shouldReturn result'
+	package:'Compiler'!
+!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: '*Compiler'!
+
+context
+	^ context ifNil: [ context := AIContext new ]
+!
+
 context: anAIContext
 	context := anAIContext
+!
+
+currentNode
+	^ currentNode
+!
+
+result
+	^ result
 ! !
 
 !ASTInterpreter methodsFor: '*Compiler'!
@@ -3774,71 +4012,367 @@ initialize
 
 interpret: aNode
 	shouldReturn := false.
-    ^ self interpretNode: aNode
+    self interpret: aNode continue: [ :value |
+    	result := value ]
 !
 
-interpretNode: aNode
-	currentNode := aNode.
-    ^ self visit: aNode
+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 ]
 !
 
-messageFromSendNode: aSendNode
-	^ Message new
-    	selector: aSendNode selector;
-        arguments: (aSendNode arguments collect: [ :each |
-        	self interpretNode: each ]);
-        yourself
-! !
+interpretAssignmentNode: aNode continue: aBlock
+	self interpret: aNode right continue: [ :value |
+    	self 
+        	continue: aBlock
+            value: (self assign: aNode left to: value) ]
+!
 
-!ASTInterpreter methodsFor: '*Compiler'!
+interpretBlockNode: aNode continue: aBlock
+	"TODO: Context should be set"
+    
+    self 
+    	continue: aBlock 
+        value: [ self interpret: aNode nodes first; result ]
+!
 
-visitBlockNode: aNode
-    ^ [ self interpretNode: aNode nodes first ]
+interpretBlockSequenceNode: aNode continue: aBlock
+	self interpretSequenceNode: aNode continue: aBlock
 !
 
-visitCascadeNode: aNode
+interpretCascadeNode: aNode continue: aBlock
 	"TODO: Handle super sends"
-	| receiver |
-    
-    receiver := self interpretNode: aNode receiver.
-
-    aNode nodes allButLast
-    	do: [ :each | 
-        	(self messageFromSendNode: each)
-            	sendTo: receiver ].
+	
+    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 ] ] ]
+!
 
-    ^ (self messageFromSendNode: aNode nodes last)
-            	sendTo: receiver
+interpretClassReferenceNode: aNode continue: aBlock
+	self continue: aBlock value: (Smalltalk current at: aNode value)
 !
 
-visitClassReferenceNode: aNode
-	^ Smalltalk current at: aNode value
+interpretDynamicArrayNode: aNode continue: aBlock
+	self interpretAll: aNode nodes continue: [ :array |
+    	self 
+        	continue: aBlock
+			value: array ]
 !
 
-visitJSStatementNode: aNode
-	self halt
+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 ]
 !
 
-visitReturnNode: aNode
+interpretJSStatementNode: aNode continue: aBlock
 	shouldReturn := true.
-    ^ self interpretNode: aNode nodes first
+	self continue: aBlock value: (self eval: aNode source)
 !
 
-visitSendNode: aNode
+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 messageFromSendNode: aNode)
-    	sendTo: (self interpretNode: aNode receiver)
+    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) ] ] ]
 !
 
-visitSequenceNode: aNode
-	aNode nodes allButLast do: [ :each | | value |
-        value := self interpretNode: each.
-		shouldReturn ifTrue: [ ^ value ] ].
-    ^ self interpretNode: aNode nodes last
+interpretSequenceNode: aNode continue: aBlock
+	self interpretAll: aNode nodes continue: [ :array |
+    	self continue: aBlock value: array last ]
 !
 
-visitValueNode: aNode
-	^ aNode value
+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: '*Compiler'!
+
+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: '*Compiler'!
+
+shouldReturn
+	^ shouldReturn ifNil: [ false ]
+! !
+
+ASTInterpreter subclass: #ASTSteppingInterpreter
+	instanceVariableNames: 'continuation nextNode'
+	package:'Compiler'!
+!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: '*Compiler'!
+
+nextNode
+	^ nextNode
+! !
+
+!ASTSteppingInterpreter methodsFor: '*Compiler'!
+
+initialize
+	super initialize.
+    continuation := [  ]
+! !
+
+!ASTSteppingInterpreter methodsFor: '*Compiler'!
+
+interpret: aNode continue: aBlock
+	nextNode := aNode.
+	continuation := [ 
+    	super interpret: aNode continue: aBlock ]
+! !
+
+!ASTSteppingInterpreter methodsFor: '*Compiler'!
+
+step
+	continuation value
+! !
+
+!ASTSteppingInterpreter methodsFor: '*Compiler'!
+
+atEnd
+	^ self shouldReturn or: [ self nextNode == self currentNode ]
+! !
+
+!Node methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretNode: self continue: aBlock
+!
+
+isSteppingNode
+	^ false
+! !
+
+!AssignmentNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretAssignmentNode: self continue: aBlock
+!
+
+isSteppingNode
+	^ true
+! !
+
+!BlockNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretBlockNode: self continue: aBlock
+!
+
+isSteppingNode
+	^ true
+! !
+
+!CascadeNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretCascadeNode: self continue: aBlock
+! !
+
+!DynamicArrayNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretDynamicArrayNode: self continue: aBlock
+!
+
+isSteppingNode
+	^ true
+! !
+
+!DynamicDictionaryNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretDynamicDictionaryNode: self continue: aBlock
+!
+
+isSteppingNode
+	^ true
+! !
+
+!JSStatementNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretJSStatementNode: self continue: aBlock
+!
+
+isSteppingNode
+	^ true
+! !
+
+!MethodNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretMethodNode: self continue: aBlock
+! !
+
+!ReturnNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretReturnNode: self continue: aBlock
+! !
+
+!SendNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretSendNode: self continue: aBlock
+!
+
+isSteppingNode
+	^ true
+! !
+
+!SequenceNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretSequenceNode: self continue: aBlock
+! !
+
+!BlockSequenceNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretBlockSequenceNode: self continue: aBlock
+! !
+
+!ValueNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretValueNode: self continue: aBlock
+! !
+
+!VariableNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretVariableNode: self continue: aBlock
+! !
+
+!ClassReferenceNode methodsFor: '*Compiler'!
+
+interpreter: anInterpreter continue: aBlock
+	^ anInterpreter interpretClassReferenceNode: self continue: aBlock
 ! !