Browse Source

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 years ago
parent
commit
859a6188ea
1 changed files with 651 additions and 117 deletions
  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
 ! !