Browse Source

Changed Makefile to be able to recompile compiler suite.

Compiler.st is built automatically.
Herbert Vojčík 12 years ago
parent
commit
12f905d3d4
2 changed files with 3192 additions and 1549 deletions
  1. 3172 1541
      st/Compiler.st
  2. 20 8
      st/Makefile

+ 3172 - 1541
st/Compiler.st

@@ -1,15 +1,15 @@
 Smalltalk current createPackage: 'Compiler' properties: #{}!
 Object subclass: #ChunkParser
 	instanceVariableNames: 'stream'
-	package: 'Compiler'!
+	package:'Compiler'!
 
-!ChunkParser methodsFor: 'accessing'!
+!ChunkParser methodsFor: '*Compiler'!
 
 stream: aStream
 	stream := aStream
 ! !
 
-!ChunkParser methodsFor: 'reading'!
+!ChunkParser methodsFor: '*Compiler'!
 
 nextChunk
 	"The chunk format (Smalltalk Interchange Format or Fileout format)
@@ -34,145 +34,17 @@ nextChunk
 	^nil "a chunk needs to end with !!"
 ! !
 
-!ChunkParser class methodsFor: 'not yet classified'!
+!ChunkParser class methodsFor: '*Compiler'!
 
 on: aStream
 	^self new stream: aStream
 ! !
 
-Object subclass: #Compiler
-	instanceVariableNames: 'currentClass source unknownVariables codeGeneratorClass'
-	package: 'Compiler'!
-
-!Compiler methodsFor: 'accessing'!
-
-codeGeneratorClass
-	^codeGeneratorClass ifNil: [FunCodeGenerator]
-!
-
-codeGeneratorClass: aClass
-	codeGeneratorClass := aClass
-!
-
-currentClass
-	^currentClass
-!
-
-currentClass: aClass
-	currentClass := aClass
-!
-
-source
-	^source ifNil: ['']
-!
-
-source: aString
-	source := aString
-!
-
-unknownVariables
-	^unknownVariables
-!
-
-unknownVariables: aCollection
-	unknownVariables := aCollection
-! !
-
-!Compiler methodsFor: 'compiling'!
-
-compile: aString
-	^self compileNode: (self parse: aString)
-!
-
-compile: aString forClass: aClass
-	self currentClass: aClass.
-	self source: aString.
-	^self compile: aString
-!
-
-compileExpression: aString
-	self currentClass: DoIt.
-	self source: 'doIt ^[', aString, '] value'.
-	^self compileNode: (self parse: self source)
-!
-
-compileNode: aNode
-	| generator result |
-	generator := self codeGeneratorClass new.
-	generator
-		source: self source;
-		currentClass: self currentClass.
-	result := generator compileNode: aNode.
-	self unknownVariables: generator unknownVariables.
-	^result
-!
-
-eval: aString
-	<return eval(aString)>
-!
-
-evaluateExpression: aString
-	"Unlike #eval: evaluate a Smalltalk expression and answer the returned object"
-	| result |
-	DoIt addCompiledMethod: (self eval: (self compileExpression: aString)).
-	result := DoIt new doIt.
-	DoIt removeCompiledMethod: (DoIt methodDictionary at: 'doIt').
-	^result
-!
-
-install: aString forClass: aBehavior category: anotherString
-	| compiled |
-	compiled := self eval: (self compile: aString forClass: aBehavior).
-	compiled category: anotherString.
-	aBehavior addCompiledMethod: compiled.
-	^compiled
-!
-
-parse: aString
-    ^Smalltalk current parse: aString
-!
-
-parseExpression: aString
-    ^self parse: 'doIt ^[', aString, '] value'
-!
-
-recompile: aClass
-	aClass methodDictionary do: [:each |
-		self install: each source forClass: aClass category: each category].
-	self setupClass: aClass.
-	aClass isMetaclass ifFalse: [self recompile: aClass class]
-!
-
-recompileAll
-	Smalltalk current classes do: [:each |
-		Transcript show: each; cr.
-		[self recompile: each] valueWithTimeout: 100]
-!
-
-setupClass: aClass
-	<smalltalk.init(aClass)>
-! !
-
-!Compiler class methodsFor: 'compiling'!
-
-recompile: aClass
-	self new recompile: aClass
-!
-
-recompileAll
-	Smalltalk current classes do: [:each |
-		self recompile: each]
-! !
-
-Object subclass: #DoIt
-	instanceVariableNames: ''
-	package: 'Compiler'!
-
 Object subclass: #Exporter
 	instanceVariableNames: ''
-	package: 'Compiler'!
+	package:'Compiler'!
 
-!Exporter methodsFor: 'fileOut'!
+!Exporter methodsFor: '*Compiler'!
 
 exportAll
     "Export all packages in the system."
@@ -207,7 +79,7 @@ exportPackage: packageName
 		self exportPackageExtensionsOf: package on: stream]
 ! !
 
-!Exporter methodsFor: 'private'!
+!Exporter methodsFor: '*Compiler'!
 
 classNameFor: aClass
 	^aClass isMetaclass
@@ -301,9 +173,9 @@ exportPackageExtensionsOf: package on: aStream
 
 Exporter subclass: #ChunkExporter
 	instanceVariableNames: ''
-	package: 'Compiler'!
+	package:'Compiler'!
 
-!ChunkExporter methodsFor: 'not yet classified'!
+!ChunkExporter methodsFor: '*Compiler'!
 
 chunkEscape: aString
 	"Replace all occurrences of !! with !!!! and trim at both ends."
@@ -415,9 +287,9 @@ exportPackageExtensionsOf: package on: aStream
 
 Exporter subclass: #StrippedExporter
 	instanceVariableNames: ''
-	package: 'Compiler'!
+	package:'Compiler'!
 
-!StrippedExporter methodsFor: 'private'!
+!StrippedExporter methodsFor: '*Compiler'!
 
 exportDefinitionOf: aClass on: aStream
 	aStream 
@@ -449,9 +321,9 @@ exportMethod: aMethod of: aClass on: aStream
 
 Object subclass: #Importer
 	instanceVariableNames: ''
-	package: 'Compiler'!
+	package:'Compiler'!
 
-!Importer methodsFor: 'fileIn'!
+!Importer methodsFor: '*Compiler'!
 
 import: aStream
     | chunk result parser lastEmpty |
@@ -469,154 +341,158 @@ import: aStream
                                   	result scanFrom: parser]]]
 ! !
 
-Object subclass: #Node
-	instanceVariableNames: 'nodes'
-	package: 'Compiler'!
-
-!Node methodsFor: 'accessing'!
-
-addNode: aNode
-	self nodes add: aNode
-!
-
-nodes
-	^nodes ifNil: [nodes := Array new]
-! !
-
-!Node methodsFor: 'building'!
+Object subclass: #PackageLoader
+	instanceVariableNames: ''
+	package:'Compiler'!
 
-nodes: aCollection
-	nodes := aCollection
-! !
+!PackageLoader methodsFor: '*Compiler'!
 
-!Node methodsFor: 'testing'!
+initializePackageNamed: packageName prefix: aString
 
-isBlockNode
-	^false
+	(Package named: packageName) 
+    	setupClasses;
+        commitPathJs: '/', aString, '/js';
+        commitPathSt: '/', aString, '/st'
 !
 
-isBlockSequenceNode
-	^false
+loadPackage: packageName prefix: aString	
+	| url |
+    url := '/', aString, '/js/', packageName, '.js'.
+	jQuery 
+		ajax: url
+        options: #{
+			'type' -> 'GET'.
+			'dataType' -> 'script'.
+    		'complete' -> [ :jqXHR :textStatus | 
+				jqXHR readyState = 4 
+                	ifTrue: [ self initializePackageNamed: packageName prefix: aString ] ].
+			'error' -> [ window alert: 'Could not load package at:  ', url ]
+		}
 !
 
-isValueNode
-	^false
+loadPackages: aCollection prefix: aString
+	aCollection do: [ :each |
+    	self loadPackage: each prefix: aString ]
 ! !
 
-!Node methodsFor: 'visiting'!
+!PackageLoader class methodsFor: '*Compiler'!
 
-accept: aVisitor
-	aVisitor visitNode: self
+loadPackages: aCollection prefix: aString
+	^ self new loadPackages: aCollection prefix: aString
 ! !
 
-Node subclass: #AssignmentNode
-	instanceVariableNames: 'left right'
-	package: 'Compiler'!
-
-!AssignmentNode methodsFor: 'accessing'!
-
-left
-	^left
-!
-
-left: aNode
-	left := aNode.
-	left assigned: true
-!
-
-right
-	^right
-!
+Error subclass: #CompilerError
+	instanceVariableNames: ''
+	package:'Compiler'!
+!CompilerError commentStamp!
+I am the common superclass of all compiling errors.!
 
-right: aNode
-	right := aNode
-! !
+CompilerError subclass: #ParseError
+	instanceVariableNames: ''
+	package:'Compiler'!
+!ParseError commentStamp!
+Instance of ParseError are signaled on any parsing error. 
+See `Smalltalk >> #parse:`!
 
-!AssignmentNode methodsFor: 'visiting'!
+CompilerError subclass: #SemanticError
+	instanceVariableNames: ''
+	package:'Compiler'!
+!SemanticError commentStamp!
+I represent an abstract semantic error thrown by the SemanticAnalyzer.
+Semantic errors can be unknown variable errors, etc.
+See my subclasses for concrete errors.
 
-accept: aVisitor
-	aVisitor visitAssignmentNode: self
-! !
+The IDE should catch instances of Semantic error to deal with them when compiling!
 
-Node subclass: #BlockNode
-	instanceVariableNames: 'parameters inlined'
-	package: 'Compiler'!
+SemanticError subclass: #InliningError
+	instanceVariableNames: ''
+	package:'Compiler'!
+!InliningError commentStamp!
+Instances of InliningError are signaled when using an `InliningCodeGenerator`in a `Compiler`.!
 
-!BlockNode methodsFor: 'accessing'!
+SemanticError subclass: #InvalidAssignmentError
+	instanceVariableNames: 'variableName'
+	package:'Compiler'!
+!InvalidAssignmentError commentStamp!
+I get signaled when a pseudo variable gets assigned.!
 
-inlined
-	^inlined ifNil: [false]
-!
+!InvalidAssignmentError methodsFor: '*Compiler'!
 
-inlined: aBoolean
-	inlined := aBoolean
+messageText
+	^ ' Invalid assignment to variable: ', self variableName
 !
 
-parameters
-	^parameters ifNil: [parameters := Array new]
+variableName
+	^ variableName
 !
 
-parameters: aCollection
-	parameters := aCollection
+variableName: aString
+	variableName := aString
 ! !
 
-!BlockNode methodsFor: 'testing'!
+SemanticError subclass: #ShadowingVariableError
+	instanceVariableNames: 'variableName'
+	package:'Compiler'!
+!ShadowingVariableError commentStamp!
+I get signaled when a variable in a block or method scope shadows a variable of the same name in an outer scope.!
 
-isBlockNode
-	^true
-! !
+!ShadowingVariableError methodsFor: '*Compiler'!
+
+messageText
+	^ 'Variable shadowing error: ', self variableName, ' is already defined'
+!
 
-!BlockNode methodsFor: 'visiting'!
+variableName
+	^ variableName
+!
 
-accept: aVisitor
-	aVisitor visitBlockNode: self
+variableName: aString
+	variableName := aString
 ! !
 
-Node subclass: #CascadeNode
-	instanceVariableNames: 'receiver'
-	package: 'Compiler'!
+SemanticError subclass: #UnknownVariableError
+	instanceVariableNames: 'variableName'
+	package:'Compiler'!
+!UnknownVariableError commentStamp!
+I get signaled when a variable is not defined.
+The default behavior is to allow it, as this is how Amber currently is able to seamlessly send messages to JavaScript objects.!
 
-!CascadeNode methodsFor: 'accessing'!
+!UnknownVariableError methodsFor: '*Compiler'!
 
-receiver
-	^receiver
+variableName
+	^ variableName
 !
 
-receiver: aNode
-	receiver := aNode
-! !
-
-!CascadeNode methodsFor: 'visiting'!
-
-accept: aVisitor
-	aVisitor visitCascadeNode: self
+variableName: aString
+	variableName := aString
 ! !
 
-Node subclass: #DynamicArrayNode
-	instanceVariableNames: ''
-	package: 'Compiler'!
-
-!DynamicArrayNode methodsFor: 'visiting'!
+Object subclass: #Compiler
+	instanceVariableNames: 'currentClass source unknownVariables codeGeneratorClass'
+	package:'Compiler'!
+!Compiler commentStamp!
+I provide the public interface for compiling Amber source code into JavaScript.
 
-accept: aVisitor
-	aVisitor visitDynamicArrayNode: self
-! !
+The code generator used to produce JavaScript can be plugged with `#codeGeneratorClass`. 
+The default code generator is an instance of `InlinedCodeGenerator`!
 
-Node subclass: #DynamicDictionaryNode
-	instanceVariableNames: ''
-	package: 'Compiler'!
+!Compiler methodsFor: '*Compiler'!
 
-!DynamicDictionaryNode methodsFor: 'visiting'!
+codeGeneratorClass
+	^codeGeneratorClass ifNil: [InliningCodeGenerator]
+!
 
-accept: aVisitor
-	aVisitor visitDynamicDictionaryNode: self
-! !
+codeGeneratorClass: aClass
+	codeGeneratorClass := aClass
+!
 
-Node subclass: #JSStatementNode
-	instanceVariableNames: 'source'
-	package: 'Compiler'!
+currentClass
+	^currentClass
+!
 
-!JSStatementNode methodsFor: 'accessing'!
+currentClass: aClass
+	currentClass := aClass
+!
 
 source
 	^source ifNil: ['']
@@ -624,1590 +500,3345 @@ source
 
 source: aString
 	source := aString
-! !
+!
 
-!JSStatementNode methodsFor: 'visiting'!
+unknownVariables
+	^unknownVariables
+!
 
-accept: aVisitor
-	aVisitor visitJSStatementNode: self
+unknownVariables: aCollection
+	unknownVariables := aCollection
 ! !
 
-Node subclass: #MethodNode
-	instanceVariableNames: 'selector arguments source'
-	package: 'Compiler'!
-
-!MethodNode methodsFor: 'accessing'!
+!Compiler methodsFor: '*Compiler'!
 
-arguments
-	^arguments ifNil: [#()]
+compile: aString
+	^self compileNode: (self parse: aString)
 !
 
-arguments: aCollection
-	arguments := aCollection
+compile: aString forClass: aClass
+	self currentClass: aClass.
+	self source: aString.
+	^self compile: aString
 !
 
-selector
-	^selector
+compileExpression: aString
+	self currentClass: DoIt.
+	self source: 'doIt ^[', aString, '] value'.
+	^self compileNode: (self parse: self source)
 !
 
-selector: aString
-	selector := aString
+compileNode: aNode
+	| generator result |
+	generator := self codeGeneratorClass new.
+	generator
+		source: self source;
+		currentClass: self currentClass.
+	result := generator compileNode: aNode.
+	self unknownVariables: #().
+	^result
 !
 
-source
-	^source
+eval: aString
+	<return eval(aString)>
 !
 
-source: aString
-	source := aString
-! !
+evaluateExpression: aString
+	"Unlike #eval: evaluate a Smalltalk expression and answer the returned object"
+	| result |
+	DoIt addCompiledMethod: (self eval: (self compileExpression: aString)).
+	result := DoIt new doIt.
+	DoIt removeCompiledMethod: (DoIt methodDictionary at: 'doIt').
+	^result
+!
+
+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
+!
+
+parse: aString
+    ^Smalltalk current parse: aString
+!
+
+parseExpression: aString
+    ^self parse: 'doIt ^[', aString, '] value'
+!
+
+recompile: aClass
+	aClass methodDictionary do: [:each |
+		console log: aClass name, ' >> ', each selector.
+		self install: each source forClass: aClass category: each category].
+	self setupClass: aClass.
+	aClass isMetaclass ifFalse: [self recompile: aClass class]
+!
+
+recompileAll
+	Smalltalk current classes do: [:each |
+		Transcript show: each; cr.
+		[self recompile: each] valueWithTimeout: 100]
+!
+
+setupClass: aClass
+	<smalltalk.init(aClass)>
+! !
+
+!Compiler class methodsFor: '*Compiler'!
+
+recompile: aClass
+	self new recompile: aClass
+!
+
+recompileAll
+	Smalltalk current classes do: [:each |
+		self recompile: each]
+! !
+
+Object subclass: #DoIt
+	instanceVariableNames: ''
+	package:'Compiler'!
+!DoIt commentStamp!
+`DoIt` is the class used to compile and evaluate expressions. See `Compiler >> evaluateExpression:`.!
+
+Object subclass: #NodeVisitor
+	instanceVariableNames: ''
+	package:'Compiler'!
+!NodeVisitor commentStamp!
+I am the abstract super class of all AST node visitors.!
+
+!NodeVisitor methodsFor: '*Compiler'!
+
+visit: aNode
+	^ aNode accept: self
+!
+
+visitAll: aCollection
+	^ aCollection do: [ :each | self visit: each ]
+!
+
+visitAssignmentNode: aNode
+	^ self visitNode: aNode
+!
+
+visitBlockNode: aNode
+	^ self visitNode: aNode
+!
+
+visitBlockSequenceNode: aNode
+	^ self visitSequenceNode: aNode
+!
+
+visitCascadeNode: aNode
+	^ self visitNode: aNode
+!
+
+visitClassReferenceNode: aNode
+	^ self visitVariableNode: aNode
+!
+
+visitDynamicArrayNode: aNode
+	^ self visitNode: aNode
+!
+
+visitDynamicDictionaryNode: aNode
+	^ self visitNode: aNode
+!
+
+visitJSStatementNode: aNode
+	^ self visitNode: aNode
+!
+
+visitMethodNode: aNode
+	^ self visitNode: aNode
+!
+
+visitNode: aNode
+	^ self visitAll: aNode nodes
+!
+
+visitReturnNode: aNode
+	^ self visitNode: aNode
+!
+
+visitSendNode: aNode
+	^ self visitNode: aNode
+!
+
+visitSequenceNode: aNode
+	^ self visitNode: aNode
+!
+
+visitValueNode: aNode
+	^ self visitNode: aNode
+!
+
+visitVariableNode: aNode
+	^ self visitNode: aNode
+! !
+
+NodeVisitor subclass: #AbstractCodeGenerator
+	instanceVariableNames: 'currentClass source'
+	package:'Compiler'!
+!AbstractCodeGenerator commentStamp!
+I am the abstract super class of all code generators and provide their common API.!
+
+!AbstractCodeGenerator methodsFor: '*Compiler'!
+
+classNameFor: aClass
+	^aClass isMetaclass
+	    ifTrue: [aClass instanceClass name, '.klass']
+	    ifFalse: [
+		aClass isNil
+		    ifTrue: ['nil']
+		    ifFalse: [aClass name]]
+!
+
+currentClass
+	^currentClass
+!
+
+currentClass: aClass
+	currentClass := aClass
+!
+
+pseudoVariables
+	^#('self' 'super' 'true' 'false' 'nil' 'thisContext')
+!
+
+safeVariableNameFor: aString
+	^(Smalltalk current reservedWords includes: aString)
+		ifTrue: [aString, '_']
+		ifFalse: [aString]
+!
+
+source
+	^source ifNil: ['']
+!
+
+source: aString
+	source := aString
+! !
+
+!AbstractCodeGenerator methodsFor: '*Compiler'!
+
+compileNode: aNode
+	self subclassResponsibility
+! !
+
+AbstractCodeGenerator subclass: #CodeGenerator
+	instanceVariableNames: ''
+	package:'Compiler'!
+!CodeGenerator commentStamp!
+I am a basic code generator. I generate a valid JavaScript output, but no not perform any inlining.
+See `InliningCodeGenerator` for an optimized JavaScript code generation.!
+
+!CodeGenerator methodsFor: '*Compiler'!
+
+compileNode: aNode
+	| ir stream |
+	self semanticAnalyzer visit: aNode.
+	ir := self translator visit: aNode.
+	^ self irTranslator
+		visit: ir;
+		contents
+!
+
+irTranslator
+	^ IRJSTranslator new
+!
+
+semanticAnalyzer
+	^ SemanticAnalyzer on: self currentClass
+!
+
+translator
+	^ IRASTTranslator new
+		source: self source;
+		theClass: self currentClass;
+		yourself
+! !
+
+Object subclass: #Node
+	instanceVariableNames: 'position nodes shouldBeInlined shouldBeAliased'
+	package:'Compiler'!
+!Node commentStamp!
+I am the abstract root class of the abstract syntax tree.
+
+position: holds a point containing lline- and column number of the symbol location in the original source file!
+
+!Node methodsFor: '*Compiler'!
+
+addNode: aNode
+	self nodes add: aNode
+!
+
+nodes
+	^nodes ifNil: [nodes := Array new]
+!
+
+position
+	^position ifNil: [position := 0@0]
+!
+
+shouldBeAliased
+	^ shouldBeAliased ifNil: [ false ]
+!
+
+shouldBeAliased: aBoolean
+	shouldBeAliased := aBoolean
+!
+
+shouldBeInlined
+	^ shouldBeInlined ifNil: [ false ]
+!
+
+shouldBeInlined: aBoolean
+	shouldBeInlined := aBoolean
+! !
+
+!Node methodsFor: '*Compiler'!
+
+nodes: aCollection
+	nodes := aCollection
+!
+
+position: aPosition
+	position := aPosition
+! !
+
+!Node methodsFor: '*Compiler'!
+
+isAssignmentNode
+	^ false
+!
+
+isBlockNode
+	^false
+!
+
+isBlockSequenceNode
+	^false
+!
+
+isImmutable
+	^false
+!
+
+isReturnNode
+	^false
+!
+
+isSendNode
+	^false
+!
+
+isValueNode
+	^false
+!
+
+subtreeNeedsAliasing
+    ^(self shouldBeAliased or: [ self shouldBeInlined ]) or: [
+        (self nodes detect: [ :each | each subtreeNeedsAliasing ] ifNone: [ false ]) ~= false ]
+! !
+
+!Node methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitNode: self
+! !
+
+Node subclass: #AssignmentNode
+	instanceVariableNames: 'left right'
+	package:'Compiler'!
+
+!AssignmentNode methodsFor: '*Compiler'!
+
+left
+	^left
+!
+
+left: aNode
+	left := aNode
+!
+
+nodes
+	^ Array with: self left with: self right
+!
+
+right
+	^right
+!
+
+right: aNode
+	right := aNode
+! !
+
+!AssignmentNode methodsFor: '*Compiler'!
+
+isAssignmentNode
+	^ true
+! !
+
+!AssignmentNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitAssignmentNode: self
+! !
+
+Node subclass: #BlockNode
+	instanceVariableNames: 'parameters scope'
+	package:'Compiler'!
+
+!BlockNode methodsFor: '*Compiler'!
+
+parameters
+	^parameters ifNil: [parameters := Array new]
+!
+
+parameters: aCollection
+	parameters := aCollection
+!
+
+scope
+	^ scope
+!
+
+scope: aLexicalScope
+	scope := aLexicalScope
+! !
+
+!BlockNode methodsFor: '*Compiler'!
+
+isBlockNode
+	^true
+! !
+
+!BlockNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitBlockNode: self
+! !
+
+Node subclass: #CascadeNode
+	instanceVariableNames: 'receiver'
+	package:'Compiler'!
+
+!CascadeNode methodsFor: '*Compiler'!
+
+receiver
+	^receiver
+!
+
+receiver: aNode
+	receiver := aNode
+! !
+
+!CascadeNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitCascadeNode: self
+! !
+
+Node subclass: #DynamicArrayNode
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!DynamicArrayNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitDynamicArrayNode: self
+! !
+
+Node subclass: #DynamicDictionaryNode
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!DynamicDictionaryNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitDynamicDictionaryNode: self
+! !
+
+Node subclass: #JSStatementNode
+	instanceVariableNames: 'source'
+	package:'Compiler'!
+
+!JSStatementNode methodsFor: '*Compiler'!
+
+source
+	^source ifNil: ['']
+!
+
+source: aString
+	source := aString
+! !
+
+!JSStatementNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitJSStatementNode: self
+! !
+
+Node subclass: #MethodNode
+	instanceVariableNames: 'selector arguments source scope classReferences messageSends superSends'
+	package:'Compiler'!
+
+!MethodNode methodsFor: '*Compiler'!
+
+arguments
+	^arguments ifNil: [#()]
+!
+
+arguments: aCollection
+	arguments := aCollection
+!
+
+classReferences
+	^ classReferences
+!
+
+classReferences: aCollection
+	classReferences := aCollection
+!
+
+messageSends
+	^ messageSends
+!
+
+messageSends: aCollection
+	messageSends := aCollection
+!
+
+scope
+	^ scope
+!
+
+scope: aMethodScope
+	scope := aMethodScope
+!
+
+selector
+	^selector
+!
+
+selector: aString
+	selector := aString
+!
+
+source
+	^source
+!
+
+source: aString
+	source := aString
+!
+
+superSends
+	^ superSends
+!
+
+superSends: aCollection
+	superSends := aCollection
+! !
+
+!MethodNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitMethodNode: self
+! !
+
+Node subclass: #ReturnNode
+	instanceVariableNames: 'scope'
+	package:'Compiler'!
+
+!ReturnNode methodsFor: '*Compiler'!
+
+scope
+	^ scope
+!
+
+scope: aLexicalScope
+	scope := aLexicalScope
+! !
+
+!ReturnNode methodsFor: '*Compiler'!
+
+isReturnNode
+	^ true
+!
+
+nonLocalReturn
+	^ self scope isMethodScope not
+! !
+
+!ReturnNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitReturnNode: self
+! !
+
+Node subclass: #SendNode
+	instanceVariableNames: 'selector arguments receiver superSend index'
+	package:'Compiler'!
+
+!SendNode methodsFor: '*Compiler'!
+
+arguments
+	^arguments ifNil: [arguments := #()]
+!
+
+arguments: aCollection
+	arguments := aCollection
+!
+
+cascadeNodeWithMessages: aCollection
+	| first |
+	first := SendNode new
+	    selector: self selector;
+	    arguments: self arguments;
+	    yourself.
+	^CascadeNode new
+	    receiver: self receiver;
+	    nodes: (Array with: first), aCollection;
+	    yourself
+!
+
+index
+	^ index
+!
+
+index: anInteger
+	index := anInteger
+!
+
+nodes
+	^ (Array withAll: self arguments)
+		add: self receiver;
+		yourself
+!
+
+receiver
+	^receiver
+!
+
+receiver: aNode
+	receiver := aNode
+!
+
+selector
+	^selector
+!
+
+selector: aString
+	selector := aString
+!
+
+superSend
+	^ superSend ifNil: [ false ]
+!
+
+superSend: aBoolean
+	superSend := aBoolean
+!
+
+valueForReceiver: anObject
+	^SendNode new
+	    receiver: (self receiver 
+		ifNil: [anObject]
+		ifNotNil: [self receiver valueForReceiver: anObject]);
+	    selector: self selector;
+	    arguments: self arguments;
+	    yourself
+! !
+
+!SendNode methodsFor: '*Compiler'!
+
+isSendNode
+	^ true
+! !
+
+!SendNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitSendNode: self
+! !
+
+Node subclass: #SequenceNode
+	instanceVariableNames: 'temps scope'
+	package:'Compiler'!
+
+!SequenceNode methodsFor: '*Compiler'!
+
+scope
+	^ scope
+!
+
+scope: aLexicalScope
+	scope := aLexicalScope
+!
+
+temps
+	^temps ifNil: [#()]
+!
+
+temps: aCollection
+	temps := aCollection
+! !
+
+!SequenceNode methodsFor: '*Compiler'!
+
+asBlockSequenceNode
+	^BlockSequenceNode new
+	    nodes: self nodes;
+	    temps: self temps;
+	    yourself
+! !
+
+!SequenceNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitSequenceNode: self
+! !
+
+SequenceNode subclass: #BlockSequenceNode
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!BlockSequenceNode methodsFor: '*Compiler'!
+
+isBlockSequenceNode
+	^true
+! !
+
+!BlockSequenceNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitBlockSequenceNode: self
+! !
+
+Node subclass: #ValueNode
+	instanceVariableNames: 'value'
+	package:'Compiler'!
+
+!ValueNode methodsFor: '*Compiler'!
+
+value
+	^value
+!
+
+value: anObject
+	value := anObject
+! !
+
+!ValueNode methodsFor: '*Compiler'!
+
+isImmutable
+	^true
+!
+
+isValueNode
+	^true
+! !
+
+!ValueNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitValueNode: self
+! !
+
+ValueNode subclass: #VariableNode
+	instanceVariableNames: 'assigned binding'
+	package:'Compiler'!
+
+!VariableNode methodsFor: '*Compiler'!
+
+alias
+	^ self binding alias
+!
+
+assigned
+	^assigned ifNil: [false]
+!
+
+assigned: aBoolean
+	assigned := aBoolean
+!
+
+beAssigned
+	self binding validateAssignment.
+	assigned := true
+!
+
+binding
+	^ binding
+!
+
+binding: aScopeVar
+	binding := aScopeVar
+! !
+
+!VariableNode methodsFor: '*Compiler'!
+
+isImmutable
+	^false
+! !
+
+!VariableNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitVariableNode: self
+! !
+
+VariableNode subclass: #ClassReferenceNode
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!ClassReferenceNode methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitClassReferenceNode: self
+! !
+
+Object subclass: #LexicalScope
+	instanceVariableNames: 'node instruction temps args outerScope'
+	package:'Compiler'!
+!LexicalScope commentStamp!
+I represent a lexical scope where variable names are associated with ScopeVars
+Instances are used for block scopes. Method scopes are instances of MethodLexicalScope.
+
+I am attached to a ScopeVar and method/block nodes.
+Each context (method/closure) get a fresh scope that inherits from its outer scope.!
+
+!LexicalScope methodsFor: '*Compiler'!
+
+alias
+	^ '$ctx', self scopeLevel asString
+!
+
+allVariableNames
+	^ self args keys, self temps keys
+!
+
+args
+	^ args ifNil: [ args := Dictionary new ]
+!
+
+bindingFor: aStringOrNode
+	^ self pseudoVars at: aStringOrNode value ifAbsent: [ 
+		self args at: aStringOrNode value ifAbsent: [
+			self temps at: aStringOrNode value ifAbsent: [ nil ]]]
+!
+
+instruction
+	^ instruction
+!
+
+instruction: anIRInstruction
+	instruction := anIRInstruction
+!
+
+lookupVariable: aNode
+	| lookup |
+	lookup := (self bindingFor: aNode).
+	lookup ifNil: [
+		lookup := self outerScope ifNotNil: [ 
+			(self outerScope lookupVariable: aNode) ]].
+	^ lookup
+!
+
+methodScope
+	^ self outerScope ifNotNil: [
+		self outerScope methodScope ]
+!
+
+node
+	"Answer the node in which I am defined"
+	
+	^ node
+!
+
+node: aNode
+	node := aNode
+!
+
+outerScope
+	^ outerScope
+!
+
+outerScope: aLexicalScope
+	outerScope := aLexicalScope
+!
+
+pseudoVars
+	^ self methodScope pseudoVars
+!
+
+scopeLevel
+	self outerScope ifNil: [ ^ 1 ].
+	self isInlined ifTrue: [ ^ self outerScope scopeLevel ].
+    
+	^ self outerScope scopeLevel + 1
+!
+
+temps
+	^ temps ifNil: [ temps := Dictionary new ]
+! !
+
+!LexicalScope methodsFor: '*Compiler'!
+
+addArg: aString
+	self args at: aString put: (ArgVar on: aString).
+	(self args at: aString) scope: self
+!
+
+addTemp: aString
+	self temps at: aString put: (TempVar on: aString).
+	(self temps at: aString) scope: self
+! !
+
+!LexicalScope methodsFor: '*Compiler'!
+
+canInlineNonLocalReturns
+	^ self isInlined and: [ self outerScope canInlineNonLocalReturns ]
+!
+
+isBlockScope
+	^ self isMethodScope not
+!
+
+isInlined
+	^ self instruction notNil and: [
+      	self instruction isInlined ]
+!
+
+isMethodScope
+	^ false
+! !
+
+LexicalScope subclass: #MethodLexicalScope
+	instanceVariableNames: 'iVars pseudoVars unknownVariables localReturn nonLocalReturns'
+	package:'Compiler'!
+!MethodLexicalScope commentStamp!
+I represent a method scope.!
+
+!MethodLexicalScope methodsFor: '*Compiler'!
+
+allVariableNames
+	^ super allVariableNames, self iVars keys
+!
+
+bindingFor: aNode
+	^ (super bindingFor: aNode) ifNil: [
+		self iVars at: aNode value ifAbsent: [ nil ]]
+!
+
+iVars
+	^ iVars ifNil: [ iVars := Dictionary new ]
+!
+
+localReturn
+	^ localReturn ifNil: [ false ]
+!
+
+localReturn: aBoolean
+	localReturn := aBoolean
+!
+
+methodScope
+	^ self
+!
+
+nonLocalReturns
+	^ nonLocalReturns ifNil: [ nonLocalReturns := OrderedCollection new ]
+!
+
+pseudoVars
+	pseudoVars ifNil: [
+		pseudoVars := Dictionary new.
+		Smalltalk current pseudoVariableNames do: [ :each |
+			pseudoVars at: each put: ((PseudoVar on: each)
+				scope: self methodScope;
+				yourself) ]].
+	^ pseudoVars
+!
+
+unknownVariables
+	^ unknownVariables ifNil: [ unknownVariables := OrderedCollection new ]
+! !
+
+!MethodLexicalScope methodsFor: '*Compiler'!
+
+addIVar: aString
+	self iVars at: aString put: (InstanceVar on: aString).
+	(self iVars at: aString) scope: self
+!
+
+addNonLocalReturn: aScope
+	self nonLocalReturns add: aScope
+!
+
+removeNonLocalReturn: aScope
+	self nonLocalReturns remove: aScope ifAbsent: []
+! !
+
+!MethodLexicalScope methodsFor: '*Compiler'!
+
+canInlineNonLocalReturns
+	^ true
+!
+
+hasLocalReturn
+	^ self localReturn
+!
+
+hasNonLocalReturn
+	^ self nonLocalReturns notEmpty
+!
+
+isMethodScope
+	^ true
+! !
+
+Object subclass: #ScopeVar
+	instanceVariableNames: 'scope name'
+	package:'Compiler'!
+!ScopeVar commentStamp!
+I am an entry in a LexicalScope that gets associated with variable nodes of the same name.  
+There are 4 different subclasses of vars: temp vars, local vars, args, and unknown/global vars.!
+
+!ScopeVar methodsFor: '*Compiler'!
+
+alias
+	^ self name asVariableName
+!
+
+name
+	^ name
+!
+
+name: aString
+	name := aString
+!
+
+scope
+	^ scope
+!
+
+scope: aScope
+	scope := aScope
+! !
+
+!ScopeVar methodsFor: '*Compiler'!
+
+isArgVar
+	^ false
+!
+
+isClassRefVar
+	^ false
+!
+
+isInstanceVar
+	^ false
+!
+
+isPseudoVar
+	^ false
+!
+
+isTempVar
+	^ false
+!
+
+isUnknownVar
+	^ false
+!
+
+validateAssignment
+	(self isArgVar or: [ self isPseudoVar ]) ifTrue: [
+		InvalidAssignmentError new
+			variableName: self name;
+			signal]
+! !
+
+!ScopeVar class methodsFor: '*Compiler'!
+
+on: aString
+	^ self new 
+		name: aString;
+		yourself
+! !
+
+ScopeVar subclass: #AliasVar
+	instanceVariableNames: 'node'
+	package:'Compiler'!
+!AliasVar commentStamp!
+I am an internally defined variable by the compiler!
+
+!AliasVar methodsFor: '*Compiler'!
+
+node
+	^ node
+!
+
+node: aNode
+	node := aNode
+! !
+
+ScopeVar subclass: #ArgVar
+	instanceVariableNames: ''
+	package:'Compiler'!
+!ArgVar commentStamp!
+I am an argument of a method or block.!
+
+!ArgVar methodsFor: '*Compiler'!
+
+isArgVar
+	^ true
+! !
+
+ScopeVar subclass: #ClassRefVar
+	instanceVariableNames: ''
+	package:'Compiler'!
+!ClassRefVar commentStamp!
+I am an class reference variable!
+
+!ClassRefVar methodsFor: '*Compiler'!
+
+alias
+	^ '(smalltalk.', self name, ' || ', self name, ')'
+! !
+
+!ClassRefVar methodsFor: '*Compiler'!
+
+isClassRefVar
+	^ true
+! !
+
+ScopeVar subclass: #InstanceVar
+	instanceVariableNames: ''
+	package:'Compiler'!
+!InstanceVar commentStamp!
+I am an instance variable of a method or block.!
+
+!InstanceVar methodsFor: '*Compiler'!
+
+alias
+	^ 'self["@', self name, '"]'
+!
+
+isInstanceVar
+	^ true
+! !
+
+ScopeVar subclass: #PseudoVar
+	instanceVariableNames: ''
+	package:'Compiler'!
+!PseudoVar commentStamp!
+I am an pseudo variable.
+
+The five Smalltalk pseudo variables are: 'self', 'super', 'nil', 'true' and 'false'!
+
+!PseudoVar methodsFor: '*Compiler'!
+
+alias
+	^ self name
+! !
+
+!PseudoVar methodsFor: '*Compiler'!
+
+isPseudoVar
+	^ true
+! !
+
+ScopeVar subclass: #TempVar
+	instanceVariableNames: ''
+	package:'Compiler'!
+!TempVar commentStamp!
+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
+! !
+
+ScopeVar subclass: #UnknownVar
+	instanceVariableNames: ''
+	package:'Compiler'!
+!UnknownVar commentStamp!
+I am an unknown variable. Amber uses unknown variables as JavaScript globals!
+
+!UnknownVar methodsFor: '*Compiler'!
+
+isUnknownVar
+	^ true
+! !
+
+NodeVisitor subclass: #SemanticAnalyzer
+	instanceVariableNames: 'currentScope theClass classReferences messageSends superSends'
+	package:'Compiler'!
+!SemanticAnalyzer commentStamp!
+I semantically analyze the abstract syntax tree and annotate it with informations such as non local returns and variable scopes.!
+
+!SemanticAnalyzer methodsFor: '*Compiler'!
+
+classReferences
+	^ classReferences ifNil: [ classReferences := Set new ]
+!
+
+messageSends
+	^ messageSends ifNil: [ messageSends := Dictionary new ]
+!
+
+superSends
+	^ superSends ifNil: [ superSends := Dictionary new ]
+!
+
+theClass
+	^ theClass
+!
+
+theClass: aClass
+	theClass := aClass
+! !
+
+!SemanticAnalyzer methodsFor: '*Compiler'!
+
+errorShadowingVariable: aString
+	ShadowingVariableError new
+		variableName: aString;
+		signal
+!
+
+errorUnknownVariable: aNode
+	"Throw an error if the variable is undeclared in the global JS scope (i.e. window)"
+
+	| 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. ]
+! !
+
+!SemanticAnalyzer methodsFor: '*Compiler'!
+
+newBlockScope
+	^ self newScopeOfClass: LexicalScope
+!
+
+newMethodScope
+	^ self newScopeOfClass: MethodLexicalScope
+!
+
+newScopeOfClass: aLexicalScopeClass
+	^ aLexicalScopeClass new 
+		outerScope: currentScope;
+		yourself
+! !
+
+!SemanticAnalyzer methodsFor: '*Compiler'!
+
+popScope
+	currentScope ifNotNil: [
+		currentScope := currentScope outerScope ]
+!
+
+pushScope: aScope
+	aScope outerScope: currentScope.
+	currentScope := aScope
+!
+
+validateVariableScope: aString
+	"Validate the variable scope in by doing a recursive lookup, up to the method scope"
+
+	(currentScope lookupVariable: aString) ifNotNil: [
+		self errorShadowingVariable: aString ]
+! !
+
+!SemanticAnalyzer methodsFor: '*Compiler'!
+
+isVariableGloballyUndefined: aString
+	<return eval('typeof ' + aString + ' == "undefined"')>
+! !
+
+!SemanticAnalyzer methodsFor: '*Compiler'!
+
+visitAssignmentNode: aNode
+	super visitAssignmentNode: aNode.
+	aNode left beAssigned
+!
+
+visitBlockNode: aNode
+	self pushScope: self newBlockScope.
+	aNode scope: currentScope.
+	currentScope node: aNode.
+	
+	aNode parameters do: [ :each | 
+		self validateVariableScope: each.
+		currentScope addArg: each ].
+
+	super visitBlockNode: aNode.
+	self popScope
+!
+
+visitCascadeNode: aNode
+	"Populate the receiver into all children"
+	aNode nodes do: [ :each | 
+		each receiver: aNode receiver ].
+	super visitCascadeNode: aNode.
+	aNode nodes first superSend ifTrue: [
+		aNode nodes do: [ :each | each superSend: true ]]
+!
+
+visitClassReferenceNode: aNode
+	self classReferences add: aNode value.
+	aNode binding: (ClassRefVar new name: aNode value; yourself)
+!
+
+visitMethodNode: aNode
+	self pushScope: self newMethodScope.
+	aNode scope: currentScope.
+	currentScope node: aNode.
+
+	self theClass allInstanceVariableNames do: [:each | 
+		currentScope addIVar: each ].
+	aNode arguments do: [ :each | 
+		self validateVariableScope: each.
+		currentScope addArg: each ].
+
+	super visitMethodNode: aNode.
+
+	aNode 
+		classReferences: self classReferences;
+		messageSends: self messageSends keys;
+        superSends: self superSends keys.
+	self popScope
+!
+
+visitReturnNode: aNode
+	aNode scope: currentScope.
+	currentScope isMethodScope
+		ifTrue: [ currentScope localReturn: true ]
+		ifFalse: [ currentScope methodScope addNonLocalReturn: currentScope ].
+	super visitReturnNode: aNode
+!
+
+visitSendNode: aNode
+
+	aNode receiver value = 'super' 
+		ifTrue: [
+			aNode superSend: true.
+			aNode receiver value: 'self'.
+			self superSends at: aNode selector ifAbsentPut: [ Set new ].
+			(self superSends at: aNode selector) add: aNode ]
+          
+		ifFalse: [ (IRSendInliner inlinedSelectors includes: aNode selector) ifTrue: [
+			aNode shouldBeInlined: true.
+			aNode receiver shouldBeAliased: true ] ].
+
+	self messageSends at: aNode selector ifAbsentPut: [ Set new ].
+	(self messageSends at: aNode selector) add: aNode.
+
+	aNode index: (self messageSends at: aNode selector) size.
+
+	super visitSendNode: aNode
+!
+
+visitSequenceNode: aNode
+	aNode temps do: [ :each | 
+		self validateVariableScope: each.
+		currentScope addTemp: each ].
+
+	super visitSequenceNode: aNode
+!
+
+visitVariableNode: aNode
+	"Bind a ScopeVar to aNode by doing a lookup in the current scope.
+	If no ScopeVar is found, bind a UnknowVar and throw an error"
+
+	aNode binding: ((currentScope lookupVariable: aNode) ifNil: [ 
+		self errorUnknownVariable: aNode.
+		UnknownVar new name: aNode value; yourself ])
+! !
+
+!SemanticAnalyzer class methodsFor: '*Compiler'!
+
+on: aClass
+	^ self new
+		theClass: aClass;
+		yourself
+! !
+
+NodeVisitor subclass: #IRASTTranslator
+	instanceVariableNames: 'source theClass method sequence nextAlias'
+	package:'Compiler'!
+!IRASTTranslator commentStamp!
+I am the AST (abstract syntax tree) visitor responsible for building the intermediate representation graph.
+I rely on a builder object, instance of IRBuilder.!
+
+!IRASTTranslator methodsFor: '*Compiler'!
+
+method
+	^ method
+!
+
+method: anIRMethod
+	method := anIRMethod
+!
+
+nextAlias
+	nextAlias ifNil: [ nextAlias := 0 ].
+	nextAlias := nextAlias + 1.
+	^ nextAlias asString
+!
+
+sequence
+	^ sequence
+!
+
+sequence: anIRSequence
+	sequence := anIRSequence
+!
+
+source
+	^ source
+!
+
+source: aString
+	source := aString
+!
+
+theClass
+	^ theClass
+!
+
+theClass: aClass
+	theClass := aClass
+!
+
+withSequence: aSequence do: aBlock
+	| outerSequence |
+	outerSequence := self sequence.
+	self sequence: aSequence.
+	aBlock value.
+	self sequence: outerSequence.
+	^ aSequence
+! !
+
+!IRASTTranslator methodsFor: '*Compiler'!
+
+alias: aNode
+	| variable |
+
+	aNode isImmutable ifTrue: [ ^ self visit: aNode ].
+
+	variable := IRVariable new 
+		variable: (AliasVar new name: '$', self nextAlias); 
+		yourself.
+
+	self sequence add: (IRAssignment new
+		add: variable;
+		add: (self visit: aNode);
+		yourself).
+
+	self method internalVariables add: variable.
+
+	^ variable
+!
+
+aliasTemporally: aCollection
+	"https://github.com/NicolasPetton/amber/issues/296
+    
+    If a node is aliased, all preceding ones are aliased as well.
+    The tree is iterated twice. First we get the aliasing dependency, 
+    then the aliasing itself is done"
+
+	| threshold result |
+    threshold := 0.
+    
+    aCollection withIndexDo: [ :each :i |
+        each subtreeNeedsAliasing
+		    ifTrue: [ threshold := i ]].
+
+	result := OrderedCollection new.
+	aCollection withIndexDo: [ :each :i | 
+		result add: (i <= threshold
+			ifTrue: [ self alias: each ]
+			ifFalse: [ self visit: each ])].
+
+    ^result
+!
+
+visitAssignmentNode: aNode
+	| left right assignment |
+	right := self visit: aNode right.
+	left := self visit: aNode left.
+	self sequence add: (IRAssignment new 
+		add: left;
+		add: right;
+		yourself).
+	^ left
+!
+
+visitBlockNode: aNode
+	| closure |
+	closure := IRClosure new
+		arguments: aNode parameters;
+		scope: aNode scope;
+		yourself.
+	aNode scope temps do: [ :each |
+		closure add: (IRTempDeclaration new 
+			name: each name;
+            scope: aNode scope;
+			yourself) ].
+	aNode nodes do: [ :each | closure add: (self visit: each) ].
+	^ closure
+!
+
+visitBlockSequenceNode: aNode
+	^ self
+		withSequence: IRBlockSequence new
+		do: [ 
+			aNode nodes ifNotEmpty: [
+				aNode nodes allButLast do: [ :each | 
+					self sequence add: (self visit: each) ].
+				aNode nodes last isReturnNode 
+					ifFalse: [ self sequence add: (IRBlockReturn new add: (self visit: aNode nodes last); yourself) ]
+					ifTrue: [ self sequence add: (self visit: aNode nodes last) ]]]
+!
+
+visitCascadeNode: aNode
+	| alias |
+
+	aNode receiver isImmutable ifFalse: [ 
+		alias := self alias: aNode receiver.
+		aNode nodes do: [ :each |
+			each receiver: (VariableNode new binding: alias variable) ]].
+
+	aNode nodes allButLast do: [ :each |
+		self sequence add: (self visit: each) ].
+
+	^ self alias: aNode nodes last
+!
+
+visitDynamicArrayNode: aNode
+	| array |
+	array := IRDynamicArray new.
+	(self aliasTemporally: aNode nodes) do: [:each | array add: each].
+	^ array
+!
+
+visitDynamicDictionaryNode: aNode
+	| dictionary |
+	dictionary := IRDynamicDictionary new.
+    (self aliasTemporally: aNode nodes) do: [:each | dictionary add: each].
+	^ dictionary
+!
+
+visitJSStatementNode: aNode
+	^ IRVerbatim new
+		source: aNode source;
+		yourself
+!
+
+visitMethodNode: aNode
+
+	self method: (IRMethod new
+		source: self source;
+        theClass: self theClass;
+		arguments: aNode arguments;
+		selector: aNode selector;
+		messageSends: aNode messageSends;
+        superSends: aNode superSends;
+		classReferences: aNode classReferences;
+		scope: aNode scope;
+		yourself).
+
+	aNode scope temps do: [ :each |
+		self method add: (IRTempDeclaration new
+			name: each name;
+            scope: aNode scope;
+			yourself) ].
+
+	aNode nodes do: [ :each | self method add: (self visit: each) ].
+
+	aNode scope hasLocalReturn ifFalse: [
+		(self method add: IRReturn new) add: (IRVariable new
+			variable: (aNode scope pseudoVars at: 'self');
+			yourself) ].
+
+	^ self method
+!
+
+visitReturnNode: aNode
+	| return |
+	return := aNode nonLocalReturn 
+		ifTrue: [ IRNonLocalReturn new ]
+		ifFalse: [ IRReturn new ].
+	return scope: aNode scope.
+	aNode nodes do: [ :each |
+		return add: (self alias: each) ].
+	^ return
+!
+
+visitSendNode: aNode
+	| send all receiver arguments |
+	send := IRSend new.
+	send 
+		selector: aNode selector;
+		index: aNode index.
+	aNode superSend ifTrue: [ send classSend: self theClass superclass ].
+    
+    all := self aliasTemporally: { aNode receiver }, aNode arguments.
+	receiver := all first.
+	arguments := all allButFirst.
+
+	send add: receiver.
+	arguments do: [ :each | send add: each ].
+
+	^ send
+!
+
+visitSequenceNode: aNode
+	^ self 
+		withSequence: IRSequence new 	
+		do: [
+			aNode nodes do: [ :each | | instruction |
+				instruction := self visit: each.
+				instruction isVariable ifFalse: [
+					self sequence add: instruction ]]]
+!
+
+visitValueNode: aNode
+	^ IRValue new 
+		value: aNode value; 
+		yourself
+!
+
+visitVariableNode: aNode
+	^ IRVariable new 
+		variable: aNode binding; 
+		yourself
+! !
+
+Object subclass: #IRInstruction
+	instanceVariableNames: 'parent instructions'
+	package:'Compiler'!
+!IRInstruction commentStamp!
+I am the abstract root class of the IR (intermediate representation) instructions class hierarchy.
+The IR graph is used to emit JavaScript code using a JSStream.!
+
+!IRInstruction methodsFor: '*Compiler'!
+
+instructions
+	^ instructions ifNil: [ instructions := OrderedCollection new ]
+!
+
+parent
+	^ parent
+!
+
+parent: anIRInstruction
+	parent := anIRInstruction
+! !
+
+!IRInstruction methodsFor: '*Compiler'!
+
+add: anObject
+	anObject parent: self.
+	^ self instructions add: anObject
+!
+
+remove
+	self parent remove: self
+!
+
+remove: anIRInstruction
+	self instructions remove: anIRInstruction
+!
+
+replace: anIRInstruction with: anotherIRInstruction
+	anotherIRInstruction parent: self.
+	self instructions 
+		at: (self instructions indexOf: anIRInstruction)
+		put: anotherIRInstruction
+!
+
+replaceWith: anIRInstruction
+	self parent replace: self with: anIRInstruction
+! !
+
+!IRInstruction methodsFor: '*Compiler'!
+
+canBeAssigned
+	^ true
+!
+
+isClosure
+	^ false
+!
+
+isInlined
+	^ false
+!
+
+isLocalReturn
+	^ false
+!
+
+isReturn
+	^ false
+!
+
+isSend
+	^ false
+!
+
+isSequence
+	^ false
+!
+
+isTempDeclaration
+	^ false
+!
+
+isVariable
+	^ false
+! !
+
+!IRInstruction methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRInstruction: self
+! !
+
+!IRInstruction class methodsFor: '*Compiler'!
+
+on: aBuilder
+	^ self new
+		builder: aBuilder;
+		yourself
+! !
+
+IRInstruction subclass: #IRAssignment
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!IRAssignment methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRAssignment: self
+! !
+
+IRInstruction subclass: #IRDynamicArray
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!IRDynamicArray methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRDynamicArray: self
+! !
+
+IRInstruction subclass: #IRDynamicDictionary
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!IRDynamicDictionary methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRDynamicDictionary: self
+! !
+
+IRInstruction subclass: #IRScopedInstruction
+	instanceVariableNames: 'scope'
+	package:'Compiler'!
+
+!IRScopedInstruction methodsFor: '*Compiler'!
+
+scope
+	^ scope
+!
+
+scope: aScope
+	scope := aScope
+! !
+
+IRScopedInstruction subclass: #IRClosure
+	instanceVariableNames: 'arguments'
+	package:'Compiler'!
+
+!IRClosure methodsFor: '*Compiler'!
+
+arguments
+	^ arguments ifNil: [ #() ]
+!
+
+arguments: aCollection
+	arguments := aCollection
+!
+
+scope: aScope
+	super scope: aScope.
+	aScope instruction: self
+!
+
+sequence
+	^ self instructions last
+! !
+
+!IRClosure methodsFor: '*Compiler'!
+
+isClosure
+	^ true
+! !
+
+!IRClosure methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRClosure: self
+! !
+
+IRScopedInstruction subclass: #IRMethod
+	instanceVariableNames: 'theClass source selector classReferences messageSends superSends arguments internalVariables'
+	package:'Compiler'!
+!IRMethod commentStamp!
+I am a method instruction!
+
+!IRMethod methodsFor: '*Compiler'!
+
+arguments
+	^ arguments
+!
+
+arguments: aCollection
+	arguments := aCollection
+!
+
+classReferences
+	^ classReferences
+!
+
+classReferences: aCollection
+	classReferences := aCollection
+!
+
+internalVariables
+	^ internalVariables ifNil: [ internalVariables := Set new ]
+!
+
+messageSends
+	^ messageSends
+!
+
+messageSends: aCollection
+	messageSends := aCollection
+!
+
+scope: aScope
+	super scope: aScope.
+	aScope instruction: self
+!
+
+selector
+	^ selector
+!
+
+selector: aString
+	selector := aString
+!
+
+source
+	^ source
+!
+
+source: aString
+	source := aString
+!
+
+superSends
+	^ superSends
+!
+
+superSends: aCollection
+	superSends := aCollection
+!
+
+theClass
+	^ theClass
+!
+
+theClass: aClass
+	theClass := aClass
+! !
+
+!IRMethod methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRMethod: self
+! !
+
+IRScopedInstruction subclass: #IRReturn
+	instanceVariableNames: ''
+	package:'Compiler'!
+!IRReturn commentStamp!
+I am a local return instruction.!
+
+!IRReturn methodsFor: '*Compiler'!
+
+canBeAssigned
+	^ false
+!
+
+isBlockReturn
+	^ false
+!
+
+isLocalReturn
+	^ true
+!
+
+isNonLocalReturn
+	^ self isLocalReturn not
+!
+
+isReturn
+	^ true
+! !
+
+!IRReturn methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRReturn: self
+! !
+
+IRReturn subclass: #IRBlockReturn
+	instanceVariableNames: ''
+	package:'Compiler'!
+!IRBlockReturn commentStamp!
+Smalltalk blocks return their last statement. I am a implicit block return instruction.!
+
+!IRBlockReturn methodsFor: '*Compiler'!
+
+isBlockReturn
+	^ true
+! !
+
+!IRBlockReturn methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRBlockReturn: self
+! !
+
+IRReturn subclass: #IRNonLocalReturn
+	instanceVariableNames: ''
+	package:'Compiler'!
+!IRNonLocalReturn commentStamp!
+I am a non local return instruction.
+Non local returns are handled using a try/catch JS statement.
+
+See IRNonLocalReturnHandling class!
+
+!IRNonLocalReturn methodsFor: '*Compiler'!
+
+isLocalReturn
+	^ false
+! !
+
+!IRNonLocalReturn methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRNonLocalReturn: self
+! !
+
+IRScopedInstruction subclass: #IRTempDeclaration
+	instanceVariableNames: 'name'
+	package:'Compiler'!
+
+!IRTempDeclaration methodsFor: '*Compiler'!
+
+name
+	^ name
+!
+
+name: aString
+	name := aString
+! !
+
+!IRTempDeclaration methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRTempDeclaration: self
+! !
+
+IRInstruction subclass: #IRSend
+	instanceVariableNames: 'selector classSend index'
+	package:'Compiler'!
+!IRSend commentStamp!
+I am a message send instruction.!
+
+!IRSend methodsFor: '*Compiler'!
+
+classSend
+	^ classSend
+!
+
+classSend: aClass
+	classSend := aClass
+!
+
+index
+	^ index
+!
+
+index: anInteger
+	index := anInteger
+!
+
+javascriptSelector
+	^ self classSend 
+    	ifNil: [ self selector asSelector ]
+      	ifNotNil: [ self selector asSuperSelector ]
+!
+
+selector
+	^ selector
+!
+
+selector: aString
+	selector := aString
+! !
+
+!IRSend methodsFor: '*Compiler'!
+
+isSend
+	^ true
+! !
+
+!IRSend methodsFor: '*Compiler'!
 
-!MethodNode methodsFor: 'visiting'!
+accept: aVisitor
+	^ aVisitor visitIRSend: self
+! !
+
+IRInstruction subclass: #IRSequence
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!IRSequence methodsFor: '*Compiler'!
+
+isSequence
+	^ true
+! !
+
+!IRSequence methodsFor: '*Compiler'!
 
 accept: aVisitor
-	aVisitor visitMethodNode: self
+	^ aVisitor visitIRSequence: self
 ! !
 
-Node subclass: #ReturnNode
+IRSequence subclass: #IRBlockSequence
 	instanceVariableNames: ''
-	package: 'Compiler'!
+	package:'Compiler'!
 
-!ReturnNode methodsFor: 'visiting'!
+!IRBlockSequence methodsFor: '*Compiler'!
 
 accept: aVisitor
-	aVisitor visitReturnNode: self
+	^ aVisitor visitIRBlockSequence: self
 ! !
 
-Node subclass: #SendNode
-	instanceVariableNames: 'selector arguments receiver'
-	package: 'Compiler'!
+IRInstruction subclass: #IRValue
+	instanceVariableNames: 'value'
+	package:'Compiler'!
+!IRValue commentStamp!
+I am the simplest possible instruction. I represent a value.!
 
-!SendNode methodsFor: 'accessing'!
+!IRValue methodsFor: '*Compiler'!
 
-arguments
-	^arguments ifNil: [arguments := #()]
+value
+	^value
 !
 
-arguments: aCollection
-	arguments := aCollection
+value: aString
+	value := aString
+! !
+
+!IRValue methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRValue: self
+! !
+
+IRInstruction subclass: #IRVariable
+	instanceVariableNames: 'variable'
+	package:'Compiler'!
+!IRVariable commentStamp!
+I am a variable instruction.!
+
+!IRVariable methodsFor: '*Compiler'!
+
+variable
+	^ variable
 !
 
-cascadeNodeWithMessages: aCollection
-	| first |
-	first := SendNode new
-	    selector: self selector;
-	    arguments: self arguments;
-	    yourself.
-	^CascadeNode new
-	    receiver: self receiver;
-	    nodes: (Array with: first), aCollection;
-	    yourself
+variable: aScopeVariable
+	variable := aScopeVariable
+! !
+
+!IRVariable methodsFor: '*Compiler'!
+
+isVariable
+	^ true
+! !
+
+!IRVariable methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRVariable: self
+! !
+
+IRInstruction subclass: #IRVerbatim
+	instanceVariableNames: 'source'
+	package:'Compiler'!
+
+!IRVerbatim methodsFor: '*Compiler'!
+
+source
+	^ source
 !
 
-receiver
-	^receiver
+source: aString
+	source := aString
+! !
+
+!IRVerbatim methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRVerbatim: self
+! !
+
+Object subclass: #IRVisitor
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!IRVisitor methodsFor: '*Compiler'!
+
+visit: anIRInstruction
+	^ anIRInstruction accept: self
 !
 
-receiver: aNode
-	receiver := aNode
+visitIRAssignment: anIRAssignment
+	^ self visitIRInstruction: anIRAssignment
 !
 
-selector
-	^selector
+visitIRBlockReturn: anIRBlockReturn
+	^ self visitIRReturn: anIRBlockReturn
 !
 
-selector: aString
-	selector := aString
+visitIRBlockSequence: anIRBlockSequence
+	^ self visitIRSequence: anIRBlockSequence
 !
 
-valueForReceiver: anObject
-	^SendNode new
-	    receiver: (self receiver 
-		ifNil: [anObject]
-		ifNotNil: [self receiver valueForReceiver: anObject]);
-	    selector: self selector;
-	    arguments: self arguments;
-	    yourself
+visitIRClosure: anIRClosure
+	^ self visitIRInstruction: anIRClosure
+!
+
+visitIRDynamicArray: anIRDynamicArray
+	^ self visitIRInstruction: anIRDynamicArray
+!
+
+visitIRDynamicDictionary: anIRDynamicDictionary
+	^ self visitIRInstruction: anIRDynamicDictionary
+!
+
+visitIRInlinedClosure: anIRInlinedClosure
+	^ self visitIRClosure: anIRInlinedClosure
+!
+
+visitIRInlinedSequence: anIRInlinedSequence
+	^ self visitIRSequence: anIRInlinedSequence
+!
+
+visitIRInstruction: anIRInstruction
+	anIRInstruction instructions do: [ :each | self visit: each ].
+	^ anIRInstruction
+!
+
+visitIRMethod: anIRMethod
+	^ self visitIRInstruction: anIRMethod
+!
+
+visitIRNonLocalReturn: anIRNonLocalReturn
+	^ self visitIRInstruction: anIRNonLocalReturn
+!
+
+visitIRNonLocalReturnHandling: anIRNonLocalReturnHandling
+	^ self visitIRInstruction: anIRNonLocalReturnHandling
+!
+
+visitIRReturn: anIRReturn
+	^ self visitIRInstruction: anIRReturn
+!
+
+visitIRSend: anIRSend
+	^ self visitIRInstruction: anIRSend
+!
+
+visitIRSequence: anIRSequence
+	^ self visitIRInstruction: anIRSequence
+!
+
+visitIRTempDeclaration: anIRTempDeclaration
+	^ self visitIRInstruction: anIRTempDeclaration
+!
+
+visitIRValue: anIRValue
+	^ self visitIRInstruction: anIRValue
+!
+
+visitIRVariable: anIRVariable
+	^ self visitIRInstruction: anIRVariable
+!
+
+visitIRVerbatim: anIRVerbatim
+	^ self visitIRInstruction: anIRVerbatim
 ! !
 
-!SendNode methodsFor: 'visiting'!
+IRVisitor subclass: #IRJSTranslator
+	instanceVariableNames: 'stream'
+	package:'Compiler'!
+
+!IRJSTranslator methodsFor: '*Compiler'!
 
-accept: aVisitor
-	aVisitor visitSendNode: self
+contents
+	^ self stream contents
+!
+
+stream
+	^ stream
+!
+
+stream: aStream
+	stream := aStream
 ! !
 
-Node subclass: #SequenceNode
-	instanceVariableNames: 'temps'
-	package: 'Compiler'!
+!IRJSTranslator methodsFor: '*Compiler'!
 
-!SequenceNode methodsFor: 'accessing'!
+initialize
+	super initialize.
+	stream := JSStream new.
+! !
 
-temps
-	^temps ifNil: [#()]
+!IRJSTranslator methodsFor: '*Compiler'!
+
+visitIRAssignment: anIRAssignment
+	self visit: anIRAssignment instructions first.
+	self stream nextPutAssignment.
+	self visit: anIRAssignment instructions last.
 !
 
-temps: aCollection
-	temps := aCollection
+visitIRClosure: anIRClosure
+	self stream 
+		nextPutClosureWith: [ 
+        	self stream 
+            	nextPutBlockContextFor: anIRClosure
+                during: [ super visitIRClosure: anIRClosure ] ]
+		arguments: anIRClosure arguments
+!
+
+visitIRDynamicArray: anIRDynamicArray
+	self stream nextPutAll: '['.
+	anIRDynamicArray instructions
+		do: [ :each | self visit: each ]
+		separatedBy: [ self stream nextPutAll: ',' ].
+	stream nextPutAll: ']'
+!
+
+visitIRDynamicDictionary: anIRDynamicDictionary
+	self stream nextPutAll: 'smalltalk.HashedCollection._fromPairs_(['.
+		anIRDynamicDictionary instructions 
+			do: [ :each | self visit: each ]
+			separatedBy: [self stream nextPutAll: ',' ].
+	self stream nextPutAll: '])'
+!
+
+visitIRMethod: anIRMethod
+	self stream
+		nextPutMethodDeclaration: anIRMethod 
+		with: [ self stream 
+			nextPutFunctionWith: [ 
+            	self stream nextPutContextFor: anIRMethod during: [
+				anIRMethod internalVariables notEmpty ifTrue: [
+					self stream nextPutVars: (anIRMethod internalVariables asArray collect: [ :each |
+						each variable alias ]) ].
+				anIRMethod scope hasNonLocalReturn 
+					ifTrue: [
+						self stream nextPutNonLocalReturnHandlingWith: [
+							super visitIRMethod: anIRMethod ]]
+					ifFalse: [ super visitIRMethod: anIRMethod ]]]
+			arguments: anIRMethod arguments ]
+!
+
+visitIRNonLocalReturn: anIRNonLocalReturn
+	self stream nextPutNonLocalReturnWith: [
+		super visitIRNonLocalReturn: anIRNonLocalReturn ]
+!
+
+visitIRReturn: anIRReturn
+	self stream nextPutReturnWith: [
+		super visitIRReturn: anIRReturn ]
+!
+
+visitIRSend: anIRSend
+	anIRSend classSend 
+    	ifNil: [
+			self stream nextPutAll: '_st('.
+			self visit: anIRSend instructions first.
+   		 	self stream nextPutAll: ').', anIRSend selector asSelector, '('.
+			anIRSend instructions allButFirst
+				do: [ :each | self visit: each ]
+				separatedBy: [ self stream nextPutAll: ',' ].
+			self stream nextPutAll: ')' ]
+		ifNotNil: [ 
+			self stream 
+            	nextPutAll: anIRSend classSend asJavascript, '.fn.prototype.';
+				nextPutAll: anIRSend selector asSelector, '.apply(';
+				nextPutAll: '_st('.
+			self visit: anIRSend instructions first.
+			self stream nextPutAll: '), ['.
+			anIRSend instructions allButFirst
+				do: [ :each | self visit: each ]
+				separatedBy: [ self stream nextPutAll: ',' ].
+			self stream nextPutAll: '])' ]
+!
+
+visitIRSequence: anIRSequence
+	self stream nextPutSequenceWith: [
+		anIRSequence instructions do: [ :each |
+			self stream nextPutStatementWith: (self visit: each) ]]
+!
+
+visitIRTempDeclaration: anIRTempDeclaration
+	self stream 
+    	nextPutAll: anIRTempDeclaration scope alias, '.locals.', anIRTempDeclaration name, '=nil;'; 
+        lf
+!
+
+visitIRValue: anIRValue
+	self stream nextPutAll: anIRValue value asJavascript
+!
+
+visitIRVariable: anIRVariable
+	anIRVariable variable name = 'thisContext'
+    	ifTrue: [ self stream nextPutAll: 'smalltalk.getThisContext()' ]
+      	ifFalse: [ self stream nextPutAll: anIRVariable variable alias ]
+!
+
+visitIRVerbatim: anIRVerbatim
+	self stream nextPutStatementWith: [
+		self stream nextPutAll: anIRVerbatim source ]
 ! !
 
-!SequenceNode methodsFor: 'testing'!
+Object subclass: #JSStream
+	instanceVariableNames: 'stream'
+	package:'Compiler'!
 
-asBlockSequenceNode
-	^BlockSequenceNode new
-	    nodes: self nodes;
-	    temps: self temps;
-	    yourself
+!JSStream methodsFor: '*Compiler'!
+
+contents
+	^ stream contents
+! !
+
+!JSStream methodsFor: '*Compiler'!
+
+initialize
+	super initialize.
+	stream := '' writeStream.
+! !
+
+!JSStream methodsFor: '*Compiler'!
+
+lf
+	stream lf
+!
+
+nextPut: aString
+	stream nextPut: aString
+!
+
+nextPutAll: aString
+	stream nextPutAll: aString
+!
+
+nextPutAssignment
+	stream nextPutAll: '='
+!
+
+nextPutBlockContextFor: anIRClosure during: aBlock
+	self 
+    	nextPutAll: 'return smalltalk.withContext(function(', anIRClosure scope alias, ') { '; 
+        nextPutAll: String cr.
+    aBlock value.
+    self nextPutAll: '})'
+!
+
+nextPutClosureWith: aBlock arguments: anArray
+	stream nextPutAll: '(function('.
+	anArray 
+		do: [ :each | stream nextPutAll: each asVariableName ]
+		separatedBy: [ stream nextPut: ',' ].
+	stream nextPutAll: '){'; lf.
+	aBlock value.
+	stream nextPutAll: '})'
+!
+
+nextPutContextFor: aMethod during: aBlock
+	self 
+    	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: aMethod theClass asJavascript;
+        nextPutAll: ')'
+!
+
+nextPutFunctionWith: aBlock arguments: anArray
+	stream nextPutAll: 'fn: function('.
+	anArray 
+		do: [ :each | stream nextPutAll: each asVariableName ]
+		separatedBy: [ stream nextPut: ',' ].
+	stream nextPutAll: '){'; lf.
+	stream nextPutAll: 'var self=this;'; lf.
+	aBlock value.
+	stream nextPutAll: '}'
+!
+
+nextPutIf: aBlock with: anotherBlock
+	stream nextPutAll: 'if('.
+	aBlock value.
+	stream nextPutAll: '){'; lf.
+	anotherBlock value.
+	stream nextPutAll: '}'
+!
+
+nextPutIfElse: aBlock with: ifBlock with: elseBlock
+	stream nextPutAll: 'if('.
+	aBlock value.
+	stream nextPutAll: '){'; lf.
+	ifBlock value.
+	stream nextPutAll: '} else {'; lf.
+	elseBlock value.
+	stream nextPutAll: '}'
+!
+
+nextPutMethodDeclaration: aMethod with: aBlock
+	stream 
+		nextPutAll: 'smalltalk.method({'; lf;
+		nextPutAll: 'selector: "', aMethod selector, '",'; lf;
+		nextPutAll: 'source: ', aMethod source asJavascript, ',';lf. 
+	aBlock value.
+	stream 
+		nextPutAll: ',', String lf, 'messageSends: ';
+		nextPutAll: aMethod messageSends asArray asJavascript, ','; lf;
+        nextPutAll: 'args: ', (aMethod arguments collect: [ :each | each value ]) asArray asJavascript, ','; lf;
+		nextPutAll: 'referencedClasses: ['.
+	aMethod classReferences 
+		do: [:each | stream nextPutAll: each asJavascript]
+		separatedBy: [stream nextPutAll: ','].
+	stream 
+		nextPutAll: ']';
+		nextPutAll: '})'
+!
+
+nextPutNonLocalReturnHandlingWith: aBlock
+	stream 
+		nextPutAll: 'var $early={};'; lf;
+		nextPutAll: 'try {'; lf.
+	aBlock value.
+	stream 
+		nextPutAll: '}'; lf;
+		nextPutAll: 'catch(e) {if(e===$early)return e[0]; throw e}'; lf
+!
+
+nextPutNonLocalReturnWith: aBlock
+	stream nextPutAll: 'throw $early=['.
+	aBlock value.
+	stream nextPutAll: ']'
+!
+
+nextPutReturn
+	stream nextPutAll: 'return '
+!
+
+nextPutReturnWith: aBlock
+	self nextPutReturn.
+	aBlock value
+!
+
+nextPutSequenceWith: aBlock
+	"stream 
+		nextPutAll: 'switch(smalltalk.thisContext.pc){'; lf."
+	aBlock value.
+	"stream 
+		nextPutAll: '};'; lf"
+!
+
+nextPutStatement: anInteger with: aBlock
+	stream nextPutAll: 'case ', anInteger asString, ':'; lf.
+	self nextPutStatementWith: aBlock.
+	stream nextPutAll: 'smalltalk.thisContext.pc=', (anInteger + 1) asString, ';'; lf
+!
+
+nextPutStatementWith: aBlock
+	aBlock value.
+	stream nextPutAll: ';'; lf
+!
+
+nextPutVar: aString
+	stream nextPutAll: 'var ', aString, ';'; lf
+!
+
+nextPutVars: aCollection
+	stream nextPutAll: 'var '.
+	aCollection 
+		do: [ :each | stream nextPutAll: each ]
+		separatedBy: [ stream nextPutAll: ',' ].
+	stream nextPutAll: ';'; lf
+! !
+
+!BlockClosure methodsFor: '*Compiler'!
+
+appendToInstruction: anIRInstruction
+    anIRInstruction appendBlock: self
+! !
+
+!String methodsFor: '*Compiler'!
+
+asVariableName
+	^ (Smalltalk current reservedWords includes: self)
+		ifTrue: [ self, '_' ]
+		ifFalse: [ self ]
+! !
+
+IRAssignment subclass: #IRInlinedAssignment
+	instanceVariableNames: ''
+	package:'Compiler'!
+!IRInlinedAssignment commentStamp!
+I represent an inlined assignment instruction.!
+
+!IRInlinedAssignment methodsFor: '*Compiler'!
+
+isInlined
+	^ true
 ! !
 
-!SequenceNode methodsFor: 'visiting'!
+!IRInlinedAssignment methodsFor: '*Compiler'!
 
 accept: aVisitor
-	aVisitor visitSequenceNode: self
+	^ aVisitor visitIRInlinedAssignment: self
 ! !
 
-SequenceNode subclass: #BlockSequenceNode
+IRClosure subclass: #IRInlinedClosure
 	instanceVariableNames: ''
-	package: 'Compiler'!
+	package:'Compiler'!
+!IRInlinedClosure commentStamp!
+I represent an inlined closure instruction.!
 
-!BlockSequenceNode methodsFor: 'testing'!
+!IRInlinedClosure methodsFor: '*Compiler'!
 
-isBlockSequenceNode
-	^true
+isInlined
+	^ true
 ! !
 
-!BlockSequenceNode methodsFor: 'visiting'!
+!IRInlinedClosure methodsFor: '*Compiler'!
 
 accept: aVisitor
-	aVisitor visitBlockSequenceNode: self
+	aVisitor visitIRInlinedClosure: self
 ! !
 
-Node subclass: #ValueNode
-	instanceVariableNames: 'value'
-	package: 'Compiler'!
+IRReturn subclass: #IRInlinedReturn
+	instanceVariableNames: ''
+	package:'Compiler'!
+!IRInlinedReturn commentStamp!
+I represent an inlined local return instruction.!
+
+!IRInlinedReturn methodsFor: '*Compiler'!
 
-!ValueNode methodsFor: 'accessing'!
+isInlined
+	^ true
+! !
+
+!IRInlinedReturn methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRInlinedReturn: self
+! !
+
+IRInlinedReturn subclass: #IRInlinedNonLocalReturn
+	instanceVariableNames: ''
+	package:'Compiler'!
+!IRInlinedNonLocalReturn commentStamp!
+I represent an inlined non local return instruction.!
+
+!IRInlinedNonLocalReturn methodsFor: '*Compiler'!
+
+isInlined
+	^ true
+! !
+
+!IRInlinedNonLocalReturn methodsFor: '*Compiler'!
+
+accept: aVisitor
+	^ aVisitor visitIRInlinedNonLocalReturn: self
+! !
+
+IRSend subclass: #IRInlinedSend
+	instanceVariableNames: ''
+	package:'Compiler'!
+!IRInlinedSend commentStamp!
+I am the abstract super class of inlined message send instructions.!
 
-value
-	^value
-!
+!IRInlinedSend methodsFor: '*Compiler'!
 
-value: anObject
-	value := anObject
+isInlined
+	^ true
 ! !
 
-!ValueNode methodsFor: 'testing'!
+!IRInlinedSend methodsFor: '*Compiler'!
 
-isValueNode
-	^true
+accept: aVisitor
+	aVisitor visitInlinedSend: self
 ! !
 
-!ValueNode methodsFor: 'visiting'!
+IRInlinedSend subclass: #IRInlinedIfFalse
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!IRInlinedIfFalse methodsFor: '*Compiler'!
 
 accept: aVisitor
-	aVisitor visitValueNode: self
+	aVisitor visitIRInlinedIfFalse: self
 ! !
 
-ValueNode subclass: #VariableNode
-	instanceVariableNames: 'assigned'
-	package: 'Compiler'!
-
-!VariableNode methodsFor: 'accessing'!
+IRInlinedSend subclass: #IRInlinedIfNilIfNotNil
+	instanceVariableNames: ''
+	package:'Compiler'!
 
-assigned
-	^assigned ifNil: [false]
-!
+!IRInlinedIfNilIfNotNil methodsFor: '*Compiler'!
 
-assigned: aBoolean
-	assigned := aBoolean
+accept: aVisitor
+	aVisitor visitIRInlinedIfNilIfNotNil: self
 ! !
 
-!VariableNode methodsFor: 'visiting'!
+IRInlinedSend subclass: #IRInlinedIfTrue
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!IRInlinedIfTrue methodsFor: '*Compiler'!
 
 accept: aVisitor
-	aVisitor visitVariableNode: self
+	aVisitor visitIRInlinedIfTrue: self
 ! !
 
-VariableNode subclass: #ClassReferenceNode
+IRInlinedSend subclass: #IRInlinedIfTrueIfFalse
 	instanceVariableNames: ''
-	package: 'Compiler'!
+	package:'Compiler'!
 
-!ClassReferenceNode methodsFor: 'visiting'!
+!IRInlinedIfTrueIfFalse methodsFor: '*Compiler'!
 
 accept: aVisitor
-	aVisitor visitClassReferenceNode: self
+	aVisitor visitIRInlinedIfTrueIfFalse: self
 ! !
 
-Node subclass: #VerbatimNode
-	instanceVariableNames: 'value'
-	package: 'Compiler'!
-
-!VerbatimNode methodsFor: 'accessing'!
+IRBlockSequence subclass: #IRInlinedSequence
+	instanceVariableNames: ''
+	package:'Compiler'!
+!IRInlinedSequence commentStamp!
+I represent a (block) sequence inside an inlined closure instruction (instance of `IRInlinedClosure`).!
 
-value
-	^value
-!
+!IRInlinedSequence methodsFor: '*Compiler'!
 
-value: anObject
-	value := anObject
+isInlined
+	^ true
 ! !
 
-!VerbatimNode methodsFor: 'visiting'!
+!IRInlinedSequence methodsFor: '*Compiler'!
 
 accept: aVisitor
-	aVisitor visitVerbatimNode: self
+	aVisitor visitIRInlinedSequence: self
 ! !
 
-Object subclass: #NodeVisitor
+IRVisitor subclass: #IRInliner
 	instanceVariableNames: ''
-	package: 'Compiler'!
-
-!NodeVisitor methodsFor: 'visiting'!
+	package:'Compiler'!
+!IRInliner commentStamp!
+I visit an IR tree, inlining message sends and block closures.
 
-visit: aNode
-	aNode accept: self
-!
+Message selectors that can be inlined are answered by `IRSendInliner >> #inlinedSelectors`!
 
-visitAssignmentNode: aNode
-	self visitNode: aNode
-!
+!IRInliner methodsFor: '*Compiler'!
 
-visitBlockNode: aNode
-	self visitNode: aNode
+assignmentInliner
+	^ IRAssignmentInliner new 
+		translator: self;
+		yourself
 !
 
-visitBlockSequenceNode: aNode
-	self visitNode: aNode
+nonLocalReturnInliner
+	^ IRNonLocalReturnInliner new 
+		translator: self;
+		yourself
 !
 
-visitCascadeNode: aNode
-	self visitNode: aNode
+returnInliner
+	^ IRReturnInliner new 
+		translator: self;
+		yourself
 !
 
-visitClassReferenceNode: aNode
-	self visitNode: aNode
-!
+sendInliner
+	^ IRSendInliner new 
+		translator: self;
+		yourself
+! !
 
-visitDynamicArrayNode: aNode
-	self visitNode: aNode
-!
+!IRInliner methodsFor: '*Compiler'!
 
-visitDynamicDictionaryNode: aNode
-	self visitNode: aNode
+shouldInlineAssignment: anIRAssignment
+	^ anIRAssignment isInlined not and: [ 
+		anIRAssignment instructions last isSend and: [	
+			self shouldInlineSend: (anIRAssignment instructions last) ]]
 !
 
-visitJSStatementNode: aNode
-	self visitNode: aNode
+shouldInlineReturn: anIRReturn
+	^ anIRReturn isInlined not and: [ 
+		anIRReturn instructions first isSend and: [	
+			self shouldInlineSend: (anIRReturn instructions first) ]]
 !
 
-visitMethodNode: aNode
-	self visitNode: aNode
-!
+shouldInlineSend: anIRSend
+	^ anIRSend isInlined not and: [
+		IRSendInliner shouldInline: anIRSend ]
+! !
 
-visitNode: aNode
-!
+!IRInliner methodsFor: '*Compiler'!
 
-visitReturnNode: aNode
-	self visitNode: aNode
-!
+transformNonLocalReturn: anIRNonLocalReturn
+	"Replace a non local return into a local return"
 
-visitSendNode: aNode
-	self visitNode: aNode
+	| localReturn |
+	anIRNonLocalReturn scope canInlineNonLocalReturns ifTrue: [
+		anIRNonLocalReturn scope methodScope removeNonLocalReturn: anIRNonLocalReturn scope.
+		localReturn := IRReturn new
+			scope: anIRNonLocalReturn scope;
+			yourself.
+		anIRNonLocalReturn instructions do: [ :each |
+			localReturn add: each ].
+		anIRNonLocalReturn replaceWith: localReturn.
+		^ localReturn ].
+	^ super visitIRNonLocalReturn: anIRNonLocalReturn
 !
 
-visitSequenceNode: aNode
-	self visitNode: aNode
+visitIRAssignment: anIRAssignment
+	^ (self shouldInlineAssignment: anIRAssignment) 
+		ifTrue: [ self assignmentInliner inlineAssignment: anIRAssignment ]
+		ifFalse: [ super visitIRAssignment: anIRAssignment ]
 !
 
-visitValueNode: aNode
-	self visitNode: aNode
+visitIRNonLocalReturn: anIRNonLocalReturn
+	^ (self shouldInlineReturn: anIRNonLocalReturn) 
+		ifTrue: [ self nonLocalReturnInliner inlineReturn: anIRNonLocalReturn ]
+		ifFalse: [ self transformNonLocalReturn: anIRNonLocalReturn ]
 !
 
-visitVariableNode: aNode
-	self visitNode: aNode
+visitIRReturn: anIRReturn
+	^ (self shouldInlineReturn: anIRReturn) 
+		ifTrue: [ self returnInliner inlineReturn: anIRReturn ]
+		ifFalse: [ super visitIRReturn: anIRReturn ]
 !
 
-visitVerbatimNode: aNode
-	self visitNode: aNode
+visitIRSend: anIRSend
+	^ (self shouldInlineSend: anIRSend)
+		ifTrue: [ self sendInliner inlineSend: anIRSend ]
+		ifFalse: [ super visitIRSend: anIRSend ]
 ! !
 
-NodeVisitor subclass: #AbstractCodeGenerator
-	instanceVariableNames: 'currentClass source'
-	package: 'Compiler'!
+IRJSTranslator subclass: #IRInliningJSTranslator
+	instanceVariableNames: ''
+	package:'Compiler'!
+!IRInliningJSTranslator commentStamp!
+I am a specialized JavaScript translator able to write inlined IR instructions to JavaScript stream (`JSStream` instance).!
 
-!AbstractCodeGenerator methodsFor: 'accessing'!
+!IRInliningJSTranslator methodsFor: '*Compiler'!
 
-classNameFor: aClass
-	^aClass isMetaclass
-	    ifTrue: [aClass instanceClass name, '.klass']
-	    ifFalse: [
-		aClass isNil
-		    ifTrue: ['nil']
-		    ifFalse: [aClass name]]
+visitIRInlinedAssignment: anIRInlinedAssignment
+	self visit: anIRInlinedAssignment instructions last
 !
 
-currentClass
-	^currentClass
+visitIRInlinedClosure: anIRInlinedClosure
+	anIRInlinedClosure instructions do: [ :each |
+		self visit: each ]
 !
 
-currentClass: aClass
-	currentClass := aClass
+visitIRInlinedIfFalse: anIRInlinedIfFalse
+	self stream nextPutIf: [ 
+		self stream nextPutAll: '!! smalltalk.assert('.
+		self visit: anIRInlinedIfFalse instructions first.
+		self stream nextPutAll: ')' ]
+		with: [ self visit: anIRInlinedIfFalse instructions last ]
 !
 
-pseudoVariables
-	^#('self' 'super' 'true' 'false' 'nil' 'thisContext')
+visitIRInlinedIfNil: anIRInlinedIfNil
+	self stream nextPutIf: [ 
+		self stream nextPutAll: '($receiver = '. 
+		self visit: anIRInlinedIfNil instructions first.
+		self stream nextPutAll: ') == nil || $receiver == undefined' ]
+		with: [ self visit: anIRInlinedIfNil instructions last ]
 !
 
-safeVariableNameFor: aString
-	^(Smalltalk current reservedWords includes: aString)
-		ifTrue: [aString, '_']
-		ifFalse: [aString]
+visitIRInlinedIfNilIfNotNil: anIRInlinedIfNilIfNotNil
+	self stream 
+		nextPutIfElse: [ 
+			self stream nextPutAll: '($receiver = '. 
+			self visit: anIRInlinedIfNilIfNotNil instructions first.
+			self stream nextPutAll: ') == nil || $receiver == undefined' ]
+		with: [ self visit: anIRInlinedIfNilIfNotNil instructions second ]
+		with: [ self visit: anIRInlinedIfNilIfNotNil instructions third ]
 !
 
-source
-	^source ifNil: ['']
+visitIRInlinedIfTrue: anIRInlinedIfTrue
+	self stream nextPutIf: [ 
+		self stream nextPutAll: 'smalltalk.assert('. 
+		self visit: anIRInlinedIfTrue instructions first.
+		self stream nextPutAll: ')' ]
+		with: [ self visit: anIRInlinedIfTrue instructions last ]
 !
 
-source: aString
-	source := aString
-! !
+visitIRInlinedIfTrueIfFalse: anIRInlinedIfTrueIfFalse
+	self stream 
+		nextPutIfElse: [ 
+			self stream nextPutAll: 'smalltalk.assert('. 
+			self visit: anIRInlinedIfTrueIfFalse instructions first.
+			self stream nextPutAll: ')' ]
+		with: [ self visit: anIRInlinedIfTrueIfFalse instructions second ]
+		with: [ self visit: anIRInlinedIfTrueIfFalse instructions third ]
+!
+
+visitIRInlinedNonLocalReturn: anIRInlinedReturn
+	self stream nextPutStatementWith: [
+		self visit: anIRInlinedReturn instructions last ].
+	self stream nextPutNonLocalReturnWith: [ ]
+!
 
-!AbstractCodeGenerator methodsFor: 'compiling'!
+visitIRInlinedReturn: anIRInlinedReturn
+	self visit: anIRInlinedReturn instructions last
+!
 
-compileNode: aNode
-	self subclassResponsibility
+visitIRInlinedSequence: anIRInlinedSequence
+	anIRInlinedSequence instructions do: [ :each | 
+		self stream nextPutStatementWith: [ self visit: each ]]
 ! !
 
-AbstractCodeGenerator subclass: #FunCodeGenerator
-	instanceVariableNames: 'stream nestedBlocks earlyReturn currentSelector unknownVariables tempVariables messageSends referencedClasses classReferenced argVariables'
-	package: 'Compiler'!
+Object subclass: #IRSendInliner
+	instanceVariableNames: 'send translator'
+	package:'Compiler'!
+!IRSendInliner commentStamp!
+I inline some message sends and block closure arguments. I heavily rely on #perform: to dispatch inlining methods.!
 
-!FunCodeGenerator methodsFor: 'accessing'!
+!IRSendInliner methodsFor: '*Compiler'!
 
-argVariables
-	^argVariables copy
+send
+	^ send
 !
 
-knownVariables
-	^self pseudoVariables 
-		addAll: self tempVariables;
-		addAll: self argVariables;
-		yourself
+send: anIRSend
+	send := anIRSend
 !
 
-tempVariables
-	^tempVariables copy
+translator
+	^ translator
 !
 
-unknownVariables
-	^unknownVariables copy
+translator: anASTTranslator
+	translator := anASTTranslator
 ! !
 
-!FunCodeGenerator methodsFor: 'compiling'!
+!IRSendInliner methodsFor: '*Compiler'!
 
-compileNode: aNode
-	stream := '' writeStream.
-	self visit: aNode.
-	^stream contents
+inliningError: aString
+	InliningError signal: aString
 ! !
 
-!FunCodeGenerator methodsFor: 'initialization'!
+!IRSendInliner methodsFor: '*Compiler'!
 
-initialize
-	super initialize.
-	stream := '' writeStream. 
-	unknownVariables := #().
-	tempVariables := #().
-	argVariables := #().
-	messageSends := #().
-	classReferenced := #()
-! !
-
-!FunCodeGenerator methodsFor: 'optimizations'!
-
-checkClass: aClassName for: receiver
-        stream nextPutAll: '((($receiver = ', receiver, ').klass === smalltalk.', aClassName, ') ? '
-!
-
-inline: aSelector receiver: receiver argumentNodes: aCollection
-        | inlined |
-        inlined := false.
-
-	"-- Booleans --"
-
-	(aSelector = 'ifFalse:') ifTrue: [
-		aCollection first isBlockNode ifTrue: [
-                	self checkClass: 'Boolean' for: receiver.
-                	stream nextPutAll: '(!! $receiver ? '.
-                	self visit: aCollection first.
-          		stream nextPutAll: '() : nil)'.
-                	inlined := true]].
-
-	(aSelector = 'ifTrue:') ifTrue: [
-		aCollection first isBlockNode ifTrue: [
-                	self checkClass: 'Boolean' for: receiver.
-                	stream nextPutAll: '($receiver ? '.
-                	self visit: aCollection first.
-          		stream nextPutAll: '() : nil)'.
-                	inlined := true]].
-
-	(aSelector = 'ifTrue:ifFalse:') ifTrue: [
-		(aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
-                	self checkClass: 'Boolean' for: receiver.
-                	stream nextPutAll: '($receiver ? '.
-                	self visit: aCollection first.
-          		stream nextPutAll: '() : '.
-          		self visit: aCollection second.
-          		stream nextPutAll: '())'.
-                	inlined := true]].
-
-	(aSelector = 'ifFalse:ifTrue:') ifTrue: [
-		(aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
-                	self checkClass: 'Boolean' for: receiver.
-                	stream nextPutAll: '(!! $receiver ? '.
-                	self visit: aCollection first.
-          		stream nextPutAll: '() : '.
-          		self visit: aCollection second.
-          		stream nextPutAll: '())'.
-                	inlined := true]].
-
-	"-- Numbers --"
-
-	(aSelector = '<') ifTrue: [
-                self checkClass: 'Number' for: receiver.
-                stream nextPutAll: '$receiver <'.
-                self visit: aCollection first.
-                inlined := true].
-
-	(aSelector = '<=') ifTrue: [
-                self checkClass: 'Number' for: receiver.
-                stream nextPutAll: '$receiver <='.
-                self visit: aCollection first.
-                inlined := true].
-
-	(aSelector = '>') ifTrue: [ 
-                self checkClass: 'Number' for: receiver.
-                stream nextPutAll: '$receiver >'.
-                self visit: aCollection first.
-                inlined := true].
-
-	(aSelector = '>=') ifTrue: [
-                self checkClass: 'Number' for: receiver.
-                stream nextPutAll: '$receiver >='.
-                self visit: aCollection first.
-                inlined := true].
-
-        (aSelector = '+') ifTrue: [
-                self checkClass: 'Number' for: receiver.
-                stream nextPutAll: '$receiver +'.
-                self visit: aCollection first.
-                inlined := true].
-
-        (aSelector = '-') ifTrue: [
-                self checkClass: 'Number' for: receiver.
-                stream nextPutAll: '$receiver -'.
-                self visit: aCollection first.
-                inlined := true].
-
-        (aSelector = '*') ifTrue: [
-                self checkClass: 'Number' for: receiver.
-                stream nextPutAll: '$receiver *'.
-                self visit: aCollection first.
-                inlined := true].
-
-        (aSelector = '/') ifTrue: [
-                self checkClass: 'Number' for: receiver.
-                stream nextPutAll: '$receiver /'.
-                self visit: aCollection first.
-                inlined := true].
-
-        ^inlined
-!
-
-inlineLiteral: aSelector receiverNode: anObject argumentNodes: aCollection
-        | inlined |
-        inlined := false.
- 
-	"-- BlockClosures --"
-
-	(aSelector = 'whileTrue:') ifTrue: [
-          	(anObject isBlockNode and: [aCollection first isBlockNode]) ifTrue: [
-                	stream nextPutAll: '(function(){while('.
-                  	self visit: anObject.
-                  	stream nextPutAll: '()) {'.
-                	self visit: aCollection first.
-          		stream nextPutAll: '()}})()'.
-                	inlined := true]].
-
-	(aSelector = 'whileFalse:') ifTrue: [
-          	(anObject isBlockNode and: [aCollection first isBlockNode]) ifTrue: [
-                	stream nextPutAll: '(function(){while(!!'.
-                  	self visit: anObject.
-                  	stream nextPutAll: '()) {'.
-                	self visit: aCollection first.
-          		stream nextPutAll: '()}})()'.
-                	inlined := true]].
-
-	(aSelector = 'whileTrue') ifTrue: [
-          	anObject isBlockNode ifTrue: [
-                	stream nextPutAll: '(function(){while('.
-                  	self visit: anObject.
-                  	stream nextPutAll: '()) {}})()'.
-                	inlined := true]].
-
-	(aSelector = 'whileFalse') ifTrue: [
-          	anObject isBlockNode ifTrue: [
-                	stream nextPutAll: '(function(){while(!!'.
-                  	self visit: anObject.
-                  	stream nextPutAll: '()) {}})()'.
-                	inlined := true]].
-
-	"-- Numbers --"
-
-	(aSelector = '+') ifTrue: [
-          	(self isNode: anObject ofClass: Number) ifTrue: [
-                  	self visit: anObject.
-                  	stream nextPutAll: ' + '.
-                	self visit: aCollection first.
-                	inlined := true]].
-
-	(aSelector = '-') ifTrue: [
-          	(self isNode: anObject ofClass: Number) ifTrue: [
-                  	self visit: anObject.
-                  	stream nextPutAll: ' - '.
-                	self visit: aCollection first.
-                	inlined := true]].
-
-	(aSelector = '*') ifTrue: [
-          	(self isNode: anObject ofClass: Number) ifTrue: [
-                  	self visit: anObject.
-                  	stream nextPutAll: ' * '.
-                	self visit: aCollection first.
-                	inlined := true]].
-
-	(aSelector = '/') ifTrue: [
-          	(self isNode: anObject ofClass: Number) ifTrue: [
-                  	self visit: anObject.
-                  	stream nextPutAll: ' / '.
-                	self visit: aCollection first.
-                	inlined := true]].
-
-	(aSelector = '<') ifTrue: [
-          	(self isNode: anObject ofClass: Number) ifTrue: [
-                  	self visit: anObject.
-                  	stream nextPutAll: ' < '.
-                	self visit: aCollection first.
-                	inlined := true]].
-
-	(aSelector = '<=') ifTrue: [
-          	(self isNode: anObject ofClass: Number) ifTrue: [
-                  	self visit: anObject.
-                  	stream nextPutAll: ' <= '.
-                	self visit: aCollection first.
-                	inlined := true]].
-
-	(aSelector = '>') ifTrue: [
-          	(self isNode: anObject ofClass: Number) ifTrue: [
-                  	self visit: anObject.
-                  	stream nextPutAll: ' > '.
-                	self visit: aCollection first.
-                	inlined := true]].
-
-	(aSelector = '>=') ifTrue: [
-          	(self isNode: anObject ofClass: Number) ifTrue: [
-                  	self visit: anObject.
-                  	stream nextPutAll: ' >= '.
-                	self visit: aCollection first.
-                	inlined := true]].
-                	   
-	"-- UndefinedObject --"
-
-	(aSelector = 'ifNil:') ifTrue: [
-		aCollection first isBlockNode ifTrue: [
-          		stream nextPutAll: '(($receiver = '.
-          		self visit: anObject.
-          		stream nextPutAll: ') == nil || $receiver == undefined) ? '.
-                  	self visit: aCollection first.
-                  	stream nextPutAll: '() : $receiver'.
-                  	inlined := true]].
-
-	(aSelector = 'ifNotNil:') ifTrue: [
-		aCollection first isBlockNode ifTrue: [
-          		stream nextPutAll: '(($receiver = '.
-          		self visit: anObject.
-          		stream nextPutAll: ') !!= nil && $receiver !!= undefined) ? '.
-                  	self visit: aCollection first.
-                  	stream nextPutAll: '() : nil'.
-                  	inlined := true]].
-
-	(aSelector = 'ifNil:ifNotNil:') ifTrue: [
-		(aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
-          		stream nextPutAll: '(($receiver = '.
-          		self visit: anObject.
-          		stream nextPutAll: ') == nil || $receiver == undefined) ? '.
-                  	self visit: aCollection first.
-                  	stream nextPutAll: '() : '.
-                  	self visit: aCollection second.
-                  	stream nextPutAll: '()'.
-                  	inlined := true]].
-
-	(aSelector = 'ifNotNil:ifNil:') ifTrue: [
-		(aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
-          		stream nextPutAll: '(($receiver = '.
-          		self visit: anObject.
-          		stream nextPutAll: ') == nil || $receiver == undefined) ? '.
-                  	self visit: aCollection second.
-                  	stream nextPutAll: '() : '.
-                  	self visit: aCollection first.
-                  	stream nextPutAll: '()'.
-                  	inlined := true]].
-                 
-        ^inlined
-!
-
-isNode: aNode ofClass: aClass
-	^aNode isValueNode and: [
-          	aNode value class = aClass or: [
-          		aNode value = 'self' and: [self currentClass = aClass]]]
-! !
-
-!FunCodeGenerator methodsFor: 'testing'!
-
-performOptimizations
-	^self class performOptimizations
-! !
-
-!FunCodeGenerator methodsFor: 'visiting'!
-
-send: aSelector to: aReceiver arguments: aCollection superSend: aBoolean
-	^String streamContents: [:str || tmp |
-        	tmp := stream.
-		str nextPutAll: 'smalltalk.send('.
-		str nextPutAll: aReceiver.
-		str nextPutAll: ', "', aSelector asSelector, '", ['.
-                stream := str.
-		aCollection
-	    		do: [:each | self visit: each]
-	    		separatedBy: [stream nextPutAll: ', '].
-                stream := tmp.
-                str nextPutAll: ']'.
-		aBoolean ifTrue: [
-			str nextPutAll: ', smalltalk.', (self classNameFor: self currentClass), '.superclass || nil'].
-		str nextPutAll: ')']
+inlinedClosure
+	^ IRInlinedClosure new
 !
 
-visit: aNode
-	aNode accept: self
-!
+inlinedSequence
+	^ IRInlinedSequence new
+! !
 
-visitAssignmentNode: aNode
-	stream nextPutAll: '('.
-	self visit: aNode left.
-	stream nextPutAll: '='.
-	self visit: aNode right.
-	stream nextPutAll: ')'
-!
+!IRSendInliner methodsFor: '*Compiler'!
 
-visitBlockNode: aNode
-	stream nextPutAll: '(function('.
-	aNode parameters 
-	    do: [:each |
-		tempVariables add: each.
-		stream nextPutAll: each]
-	    separatedBy: [stream nextPutAll: ', '].
-	stream nextPutAll: '){'.
-	aNode nodes do: [:each | self visit: each].
-	stream nextPutAll: '})'
+ifFalse: anIRInstruction
+	^ self inlinedSend: IRInlinedIfFalse new with: anIRInstruction
 !
 
-visitBlockSequenceNode: aNode
-	| index |
-	nestedBlocks := nestedBlocks + 1.
-	aNode nodes isEmpty
-	    ifTrue: [
-		stream nextPutAll: 'return nil;']
-	    ifFalse: [
-		aNode temps do: [:each | | temp |
-                    temp := self safeVariableNameFor: each.
-		    tempVariables add: temp.
-		    stream nextPutAll: 'var ', temp, '=nil;'; lf].
-		index := 0.
-		aNode nodes do: [:each |
-		    index := index + 1.
-		    index = aNode nodes size ifTrue: [
-			stream nextPutAll: 'return '].
-		    self visit: each.
-		    stream nextPutAll: ';']].
-	nestedBlocks := nestedBlocks - 1
+ifFalse: anIRInstruction ifTrue: anotherIRInstruction
+	^ self perform: #ifTrue:ifFalse: withArguments: { anotherIRInstruction. anIRInstruction }
 !
 
-visitCascadeNode: aNode
-	| index |
-	index := 0.
-	(tempVariables includes: '$rec') ifFalse: [
-		tempVariables add: '$rec'].
-	stream nextPutAll: '(function($rec){'.
-	aNode nodes do: [:each |
-	    index := index + 1.
-	    index = aNode nodes size ifTrue: [
-		stream nextPutAll: 'return '].
-	    each receiver: (VariableNode new value: '$rec').
-	    self visit: each.
-	    stream nextPutAll: ';'].
-	stream nextPutAll: '})('.
-	self visit: aNode receiver.
-	stream nextPutAll: ')'
+ifNil: anIRInstruction
+	^ self 
+		inlinedSend: IRInlinedIfNilIfNotNil new 
+		with: anIRInstruction
+		with: (IRClosure new
+			scope: anIRInstruction scope copy;
+			add: (IRBlockSequence new
+				add: self send instructions first;
+				yourself);
+			yourself)
 !
 
-visitClassReferenceNode: aNode
-	(referencedClasses includes: aNode value) ifFalse: [
-		referencedClasses add: aNode value].
-	stream nextPutAll: '(smalltalk.', aNode value, ' || ', aNode value, ')'
+ifNil: anIRInstruction ifNotNil: anotherIRInstruction
+	^ self inlinedSend: IRInlinedIfNilIfNotNil new with: anIRInstruction with: anotherIRInstruction
 !
 
-visitDynamicArrayNode: aNode
-	stream nextPutAll: '['.
-	aNode nodes 
-		do: [:each | self visit: each]
-		separatedBy: [stream nextPutAll: ','].
-	stream nextPutAll: ']'
+ifNotNil: anIRInstruction
+	^ self 
+		inlinedSend: IRInlinedIfNilIfNotNil new
+		with: (IRClosure new
+			scope: anIRInstruction scope copy;
+			add: (IRBlockSequence new
+				add: self send instructions first;
+				yourself);
+			yourself)
+		with: anIRInstruction
 !
 
-visitDynamicDictionaryNode: aNode
-	stream nextPutAll: 'smalltalk.HashedCollection._fromPairs_(['.
-		aNode nodes 
-			do: [:each | self visit: each]
-			separatedBy: [stream nextPutAll: ','].
-		stream nextPutAll: '])'
+ifNotNil: anIRInstruction ifNil: anotherIRInstruction
+	^ self inlinedSend: IRInlinedIfNilIfNotNil new with: anotherIRInstruction with: anIRInstruction
 !
 
-visitFailure: aFailure
-	self error: aFailure asString
+ifTrue: anIRInstruction
+	^ self inlinedSend: IRInlinedIfTrue new with: anIRInstruction
 !
 
-visitJSStatementNode: aNode
-	stream nextPutAll: aNode source
+ifTrue: anIRInstruction ifFalse: anotherIRInstruction
+	^ self inlinedSend: IRInlinedIfTrueIfFalse new with: anIRInstruction with: anotherIRInstruction
 !
 
-visitMethodNode: aNode
-	| str currentSelector | 
-	currentSelector := aNode selector asSelector.
-	nestedBlocks := 0.
-	earlyReturn := false.
-	messageSends := #().
-	referencedClasses := #().
-	unknownVariables := #().
-	tempVariables := #().
-	argVariables := #().
-	stream 
-	    nextPutAll: 'smalltalk.method({'; lf;
-	    nextPutAll: 'selector: "', aNode selector, '",'; lf.
-	stream nextPutAll: 'source: ', self source asJavascript, ',';lf.
-	stream nextPutAll: 'fn: function('.
-	aNode arguments 
-	    do: [:each | 
-		argVariables add: each.
-		stream nextPutAll: each]
-	    separatedBy: [stream nextPutAll: ', '].
-	stream 
-	    nextPutAll: '){'; lf;
-	    nextPutAll: 'var self=this;'; lf.
-	str := stream.
-	stream := '' writeStream.
-	aNode nodes do: [:each |
-	    self visit: each].
-	earlyReturn ifTrue: [
-	    str nextPutAll: 'var $early={};'; lf; nextPutAll: 'try{'].
-	str nextPutAll: stream contents.
-	stream := str.
-	stream 
-	    lf; 
-	    nextPutAll: 'return self;'.
-	earlyReturn ifTrue: [
-	    stream lf; nextPutAll: '} catch(e) {if(e===$early)return e[0]; throw e}'].
-	stream nextPutAll: '}'.
-	stream 
-		nextPutAll: ',', String lf, 'messageSends: ';
-		nextPutAll: messageSends asJavascript, ','; lf;
-          	nextPutAll: 'args: ', argVariables asJavascript, ','; lf;
-		nextPutAll: 'referencedClasses: ['.
-	referencedClasses 
-		do: [:each | stream nextPutAll: each printString]
-		separatedBy: [stream nextPutAll: ','].
-	stream nextPutAll: ']'.
-	stream nextPutAll: '})'
-!
+inlineClosure: anIRClosure
+	| inlinedClosure sequence statements |
 
-visitReturnNode: aNode
-	nestedBlocks > 0 ifTrue: [
-	    earlyReturn := true].
-	nestedBlocks > 0
-	    ifTrue: [
-		stream
-		    nextPutAll: '(function(){throw $early=[']
-	    ifFalse: [stream nextPutAll: 'return '].
-	aNode nodes do: [:each |
-	    self visit: each].
-	nestedBlocks > 0 ifTrue: [
-	    stream nextPutAll: ']})()']
-!
+	inlinedClosure := self inlinedClosure.
+	inlinedClosure scope: anIRClosure scope.
 
-visitSendNode: aNode
-        | str receiver superSend inlined |
-        str := stream.
-        (messageSends includes: aNode selector) ifFalse: [
-                messageSends add: aNode selector].
-        stream := '' writeStream.
-        self visit: aNode receiver.
-        superSend := stream contents = 'super'.
-        receiver := superSend ifTrue: ['self'] ifFalse: [stream contents].
-        stream := str.
+	"Add the possible temp declarations"
+	anIRClosure instructions do: [ :each | 
+		each isSequence ifFalse: [
+			inlinedClosure add: each ]].
+
+	"Add a block sequence"
+	sequence := self inlinedSequence.
+	inlinedClosure add: sequence.
+
+	"Get all the statements"
+	statements := anIRClosure instructions last instructions.
 	
-	self performOptimizations 
-		ifTrue: [
-			(self inlineLiteral: aNode selector receiverNode: aNode receiver argumentNodes: aNode arguments) ifFalse: [
-				(self inline: aNode selector receiver: receiver argumentNodes: aNode arguments)
-                			ifTrue: [stream nextPutAll: ' : ', (self send: aNode selector to: '$receiver' arguments: aNode arguments superSend: superSend), ')']
-                			ifFalse: [stream nextPutAll: (self send: aNode selector to: receiver arguments: aNode arguments superSend: superSend)]]]
-		ifFalse: [stream nextPutAll: (self send: aNode selector to: receiver arguments: aNode arguments superSend: superSend)]
-!
+	statements ifNotEmpty: [
+		statements allButLast do: [ :each | sequence add: each ].
 
-visitSequenceNode: aNode
-	aNode temps do: [:each || temp |
-            temp := self safeVariableNameFor: each.
-	    tempVariables add: temp.
-	    stream nextPutAll: 'var ', temp, '=nil;'; lf].
-	aNode nodes do: [:each |
-	    self visit: each.
-	    stream nextPutAll: ';']
-	    separatedBy: [stream lf]
+		"Inlined closures don't have implicit local returns"
+		(statements last isReturn and: [ statements last isBlockReturn ])
+			ifTrue: [ sequence add: statements last instructions first ]
+			ifFalse: [ sequence add: statements last ] ].
+
+	^ inlinedClosure
 !
 
-visitValueNode: aNode
-	stream nextPutAll: aNode value asJavascript
+inlineSend: anIRSend
+	self send: anIRSend.
+	^ self 
+		perform: self send selector 
+		withArguments: self send instructions allButFirst
 !
 
-visitVariableNode: aNode
-	| varName |
-	(self currentClass allInstanceVariableNames includes: aNode value) 
-		ifTrue: [stream nextPutAll: 'self[''@', aNode value, ''']']
-		ifFalse: [
-                  	varName := self safeVariableNameFor: aNode value.
-			(self knownVariables includes: varName) 
-                  		ifFalse: [
-                                  	unknownVariables add: aNode value.
-                                  	aNode assigned 
-                                  		ifTrue: [stream nextPutAll: varName]
-                                  		ifFalse: [stream nextPutAll: '(typeof ', varName, ' == ''undefined'' ? nil : ', varName, ')']]
-                  		ifTrue: [
-                                  	aNode value = 'thisContext'
-                                  		ifTrue: [stream nextPutAll: '(smalltalk.getThisContext())']
-                				ifFalse: [stream nextPutAll: varName]]]
-! !
+inlinedSend: inlinedSend with: anIRInstruction
+	| inlinedClosure |
 
-FunCodeGenerator class instanceVariableNames: 'performOptimizations'!
+	anIRInstruction isClosure ifFalse: [ self inliningError: 'Message argument should be a block' ].
+	anIRInstruction arguments size = 0 ifFalse: [ self inliningError: 'Inlined block should have zero argument' ].
 
-!FunCodeGenerator class methodsFor: 'accessing'!
+	inlinedClosure := self translator visit: (self inlineClosure: anIRInstruction).
 
-performOptimizations
-	^performOptimizations ifNil: [true]
+	inlinedSend
+		add: self send instructions first;
+		add: inlinedClosure.
+
+	self send replaceWith: inlinedSend.
+
+	^ inlinedSend
 !
 
-performOptimizations: aBoolean
-	performOptimizations := aBoolean
-! !
+inlinedSend: inlinedSend with: anIRInstruction with: anotherIRInstruction
+	| inlinedClosure1 inlinedClosure2 |
 
-AbstractCodeGenerator subclass: #ImpCodeGenerator
-	instanceVariableNames: 'stream nestedBlocks earlyReturn currentSelector unknownVariables tempVariables messageSends referencedClasses classReferenced argVariables mutables target lazyVars realVarNames'
-	package: 'Compiler'!
+	anIRInstruction isClosure ifFalse: [ self inliningError: 'Message argument should be a block' ].
+	anIRInstruction arguments size = 0 ifFalse: [ self inliningError: 'Inlined block should have zero argument' ].
 
-!ImpCodeGenerator methodsFor: 'accessing'!
+	anotherIRInstruction isClosure ifFalse: [ self inliningError: 'Message argument should be a block' ].
+	anotherIRInstruction arguments size = 0 ifFalse: [ self inliningError: 'Inlined block should have zero argument' ].
 
-argVariables
-	^argVariables copy
-!
+	inlinedClosure1 := self translator visit: (self inlineClosure: anIRInstruction).
+	inlinedClosure2 := self translator visit: (self inlineClosure: anotherIRInstruction).
 
-knownVariables
-	^self pseudoVariables 
-		addAll: self tempVariables;
-		addAll: self argVariables;
-		yourself
-!
 
-tempVariables
-	^tempVariables copy
-!
+	inlinedSend
+		add: self send instructions first;
+		add: inlinedClosure1;
+		add: inlinedClosure2.
 
-unknownVariables
-	^unknownVariables copy
+	self send replaceWith: inlinedSend.
+	^ inlinedSend
 ! !
 
-!ImpCodeGenerator methodsFor: 'compilation DSL'!
+!IRSendInliner class methodsFor: '*Compiler'!
 
-aboutToModifyState
-| list old |
-	list := mutables.
-	mutables := Set new.
-	old := self switchTarget: nil.
-	list do: [ :each | | value |
-		self switchTarget: each.
-		self realAssign: (lazyVars at: each)
-	].
-	self switchTarget: old
+inlinedSelectors
+	^ #('ifTrue:' 'ifFalse:' 'ifTrue:ifFalse:' 'ifFalse:ifTrue:' 'ifNil:' 'ifNotNil:' 'ifNil:ifNotNil:' 'ifNotNil:ifNil')
 !
 
-ifValueWanted: aBlock
-	target ifNotNil: aBlock
-!
+shouldInline: anIRInstruction
+	(self inlinedSelectors includes: anIRInstruction selector) ifFalse: [ ^ false ].
+	anIRInstruction instructions allButFirst do: [ :each |
+		each isClosure ifFalse: [ ^ false ]].
+	^ true
+! !
 
-isolated: node
- 	^ self visit: node targetBeing: self nextLazyvarName
-!
+IRSendInliner subclass: #IRAssignmentInliner
+	instanceVariableNames: 'assignment'
+	package:'Compiler'!
+!IRAssignmentInliner commentStamp!
+I inline message sends together with assignments by moving them around into the inline closure instructions. 
 
-isolatedUse: node
-| old |
-	old := self switchTarget: self nextLazyvarName.
-	self visit: node.
-	^self useValueNamed: (self switchTarget: old)
-!
+##Example
 
-lazyAssign: aString dependsOnState: aBoolean
-	(lazyVars includesKey: target)
-		ifTrue: [ lazyVars at: target put: aString. aBoolean ifTrue: [ mutables add: target ] ]
-		ifFalse: [ self realAssign: aString ]
-!
+	foo
+		| a |
+		a := true ifTrue: [ 1 ]
 
-lazyAssignExpression: aString
-	self lazyAssign: aString dependsOnState: true
-!
+Will produce:
 
-lazyAssignValue: aString
-	self lazyAssign: aString dependsOnState: false
-!
+	if(smalltalk.assert(true) {
+		a = 1;
+	};!
 
-makeTargetRealVariable
-	(lazyVars includesKey: target) ifTrue: [
-		lazyVars removeKey: target.
-		lazyVars at: 'assigned ',target put: nil. "<-- only to retain size, it is used in nextLazyvarName"
-		realVarNames add: target ].
-!
+!IRAssignmentInliner methodsFor: '*Compiler'!
 
-nextLazyvarName
-	| name |
-	name := '$', lazyVars size asString.
-	lazyVars at: name put: name.
-	^name
+assignment
+	^ assignment
 !
 
-nilIfValueWanted
-	target ifNotNil: [ self lazyAssignValue: 'nil' ]
-!
+assignment: aNode
+	assignment := aNode
+! !
 
-realAssign: aString
-	| closer |
-	aString ifNotEmpty: [
-		self aboutToModifyState.
-		closer := ''.
-		self ifValueWanted: [ stream nextPutAll:
-			(target = '^' ifTrue: ['return '] ifFalse: [
-				target = '!!' ifTrue: [ closer := ']'. 'throw $early=['] ifFalse: [
-					target, '=']]) ].
-		self makeTargetRealVariable.
-		stream nextPutAll: aString, closer, ';', self mylf ]
-!
+!IRAssignmentInliner methodsFor: '*Compiler'!
 
-switchTarget: aString
-	| old |
-	old := target.
-	target := aString.
-	^old
+inlineAssignment: anIRAssignment
+	| inlinedAssignment |
+	self assignment: anIRAssignment.
+	inlinedAssignment := IRInlinedAssignment new.
+	anIRAssignment instructions do: [ :each |
+		inlinedAssignment add: each ].
+	anIRAssignment replaceWith: inlinedAssignment.
+	self inlineSend: inlinedAssignment instructions last.
+	^ inlinedAssignment
 !
 
-useValueNamed: key
-	| val |
-	(realVarNames includes: key) ifTrue: [ ^key ].
-	mutables remove: key.
-	^lazyVars at: key
-!
+inlineClosure: anIRClosure
+	| inlinedClosure statements |
+
+	inlinedClosure := super inlineClosure: anIRClosure.
+	statements := inlinedClosure instructions last instructions.
+	
+	statements ifNotEmpty: [
+		statements last canBeAssigned ifTrue: [
+			statements last replaceWith: (IRAssignment new
+				add: self assignment instructions first;
+				add: statements last copy;
+				yourself) ] ].
 
-visit: aNode targetBeing: aString
-| old |
-	old := self switchTarget: aString.
-	self visit: aNode.
-	^ self switchTarget: old.
+	^ inlinedClosure
 ! !
 
-!ImpCodeGenerator methodsFor: 'compiling'!
+IRSendInliner subclass: #IRNonLocalReturnInliner
+	instanceVariableNames: ''
+	package:'Compiler'!
+
+!IRNonLocalReturnInliner methodsFor: '*Compiler'!
 
-compileNode: aNode
-	stream := '' writeStream.
-	self visit: aNode.
-	^stream contents
+inlinedReturn
+	^ IRInlinedNonLocalReturn new
 ! !
 
-!ImpCodeGenerator methodsFor: 'initialization'!
+!IRNonLocalReturnInliner methodsFor: '*Compiler'!
 
-initialize
-	super initialize.
-	stream := '' writeStream. 
-	unknownVariables := #().
-	tempVariables := #().
-	argVariables := #().
-	messageSends := #().
-	classReferenced := #().
-	mutables := Set new.
-	realVarNames := Set new.
-	lazyVars := HashedCollection new.
-	target := nil
-! !
-
-!ImpCodeGenerator methodsFor: 'optimizations'!
-
-checkClass: aClassName for: receiver
-	self prvCheckClass: aClassName for: receiver.
-	stream nextPutAll: '{'
-!
-
-checkClass: aClassName for: receiver includeIf: aBoolean
-	self prvCheckClass: aClassName for: receiver.
-	stream nextPutAll: (aBoolean ifTrue: ['if(('] ifFalse: ['if(!!(']), (self useValueNamed: receiver), ')) {'
-!
-
-inline: aSelector receiver: receiver argumentNodes: aCollection
-
-	"-- Booleans --"
-
-	(aSelector = 'ifFalse:') ifTrue: [
-		aCollection first isBlockNode ifTrue: [
-			self checkClass: 'Boolean' for: receiver includeIf: false.
-			self prvPutAndElse: [ self visit: aCollection first nodes first ].
-			self prvPutAndElse: [ self nilIfValueWanted ].
-			^true]].
-
-	(aSelector = 'ifTrue:') ifTrue: [
-		aCollection first isBlockNode ifTrue: [
-			self checkClass: 'Boolean' for: receiver includeIf: true.
-			self prvPutAndElse: [ self visit: aCollection first nodes first ].
-			self prvPutAndElse: [ self nilIfValueWanted ].
-			^true]].
-
-	(aSelector = 'ifTrue:ifFalse:') ifTrue: [
-		(aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
-			self checkClass: 'Boolean' for: receiver includeIf: true.
-			self prvPutAndElse: [ self visit: aCollection first nodes first ].
-			self prvPutAndElse: [ self visit: aCollection second nodes first ].
-			^true]].
-
-	(aSelector = 'ifFalse:ifTrue:') ifTrue: [
-		(aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [
-			self checkClass: 'Boolean' for: receiver includeIf: false.
-			self prvPutAndElse: [ self visit: aCollection first nodes first ].
-			self prvPutAndElse: [ self visit: aCollection second nodes first ].
-			^true]].
-
-	"-- Numbers --"
-
-	(aSelector = '<') ifTrue: [ | operand |
-		operand := self isolatedUse: aCollection first.
-		self checkClass: 'Number' for: receiver.
-		self prvPutAndElse: [
-			self lazyAssignExpression: '(', (self useValueNamed: receiver), '<', operand, ')' ].
-		^{ VerbatimNode new value: operand }].
-
-	(aSelector = '<=') ifTrue: [ | operand |
-		operand := self isolatedUse: aCollection first.
-		self checkClass: 'Number' for: receiver.
-		self prvPutAndElse: [
-			self lazyAssignExpression: '(', (self useValueNamed: receiver), '<=', operand, ')' ].
-		^{ VerbatimNode new value: operand }].
-
-	(aSelector = '>') ifTrue: [ | operand |
-		operand := self isolatedUse: aCollection first.
-		self checkClass: 'Number' for: receiver.
-		self prvPutAndElse: [
-			self lazyAssignExpression: '(', (self useValueNamed: receiver), '>', operand, ')' ].
-		^{ VerbatimNode new value: operand }].
-
-	(aSelector = '>=') ifTrue: [ | operand |
-		operand := self isolatedUse: aCollection first.
-		self checkClass: 'Number' for: receiver.
-		self prvPutAndElse: [
-			self lazyAssignExpression: '(', (self useValueNamed: receiver), '>=', operand, ')' ].
-		^{ VerbatimNode new value: operand }].
-
-        (aSelector = '+') ifTrue: [ | operand |
-		operand := self isolatedUse: aCollection first.
-		self checkClass: 'Number' for: receiver.
-		self prvPutAndElse: [
-			self lazyAssignExpression: '(', (self useValueNamed: receiver), '+', operand, ')' ].
-		^{ VerbatimNode new value: operand }].
-
-        (aSelector = '-') ifTrue: [ | operand |
-		operand := self isolatedUse: aCollection first.
-		self checkClass: 'Number' for: receiver.
-		self prvPutAndElse: [
-			self lazyAssignExpression: '(', (self useValueNamed: receiver), '-', operand, ')' ].
-		^{ VerbatimNode new value: operand }].
-
-        (aSelector = '*') ifTrue: [ | operand |
-		operand := self isolatedUse: aCollection first.
-		self checkClass: 'Number' for: receiver.
-		self prvPutAndElse: [
-			self lazyAssignExpression: '(', (self useValueNamed: receiver), '*', operand, ')' ].
-		^{ VerbatimNode new value: operand }].
-
-        (aSelector = '/') ifTrue: [ | operand |
-		operand := self isolatedUse: aCollection first.
-		self checkClass: 'Number' for: receiver.
-		self prvPutAndElse: [
-			self lazyAssignExpression: '(', (self useValueNamed: receiver), '/', operand, ')' ].
-		^{ VerbatimNode new value: operand }].
-
-        ^nil
-!
-
-inlineLiteral: aSelector receiverNode: anObject argumentNodes: aCollection
-        | inlined |
-        inlined := false.
- 
-	"-- BlockClosures --"
-
-	(aSelector = 'whileTrue:') ifTrue: [
-          	(anObject isBlockNode and: [aCollection first isBlockNode]) ifTrue: [ | old |
-			self prvWhileConditionStatement: 'for(;;){' pre: 'if (!!(' condition: anObject post: ')) {'.
-			stream nextPutAll: 'break}', self mylf.
-			self prvPutAndClose: [ self visit: aCollection first nodes first targetBeing: nil ].
-			inlined := true]].
-
-	(aSelector = 'whileFalse:') ifTrue: [
-          	(anObject isBlockNode and: [aCollection first isBlockNode]) ifTrue: [ | old |
-			self prvWhileConditionStatement: 'for(;;){' pre: 'if ((' condition: anObject post: ')) {'.
-			stream nextPutAll: 'break}', self mylf.
-			self prvPutAndClose: [ self visit: aCollection first nodes first targetBeing: nil ].
-			inlined := true]].
-
-	(aSelector = 'whileTrue') ifTrue: [
-          	anObject isBlockNode ifTrue: [
-			self prvWhileConditionStatement: 'do{' pre: '}while((' condition: anObject post: '));', self mylf.
-			inlined := true]].
-
-	(aSelector = 'whileFalse') ifTrue: [
-          	anObject isBlockNode ifTrue: [
-			self prvWhileConditionStatement: 'do{' pre: '}while(!!(' condition: anObject post: '));', self mylf.
-			inlined := true]].
-
-	"-- Numbers --"
-
-	(#('+' '-' '*' '/' '<' '<=' '>=' '>') includes: aSelector) ifTrue: [
-		(self prvInlineNumberOperator: aSelector on: anObject and: aCollection first) ifTrue: [
-			inlined := true]].
-                	   
-	"-- UndefinedObject --"
-
-	(aSelector = 'ifNil:') ifTrue: [
-		aCollection first isBlockNode ifTrue: [ | rcv |
-			self aboutToModifyState.
-			rcv := self isolatedUse: anObject.
-			rcv = 'super' ifTrue: [ rcv := 'self' ].
-			self makeTargetRealVariable.
-			stream nextPutAll: 'if((', rcv, ') === nil || (', rcv, ') == null) {'.
-			self prvPutAndElse: [ self visit: aCollection first nodes first ].
-			self prvPutAndClose: [ self lazyAssignValue: rcv ].
-			inlined := true]].
-
-	(aSelector = 'ifNotNil:') ifTrue: [
-		aCollection first isBlockNode ifTrue: [ | rcv |
-			self aboutToModifyState.
-			rcv := self isolatedUse: anObject.
-			rcv = 'super' ifTrue: [ rcv := 'self' ].
-			self makeTargetRealVariable.
-			stream nextPutAll: 'if((', rcv, ') !!== nil && (', rcv, ') !!= null) {'.
-			self prvPutAndElse: [ self visit: aCollection first nodes first ].
-			self prvPutAndClose: [ self lazyAssignValue: rcv ].
-			inlined := true]].
-
-	(aSelector = 'ifNil:ifNotNil:') ifTrue: [
-		(aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [ | rcv |
-			self aboutToModifyState.
-			rcv := self isolatedUse: anObject.
-			rcv = 'super' ifTrue: [ rcv := 'self' ].
-			self makeTargetRealVariable.
-			stream nextPutAll: 'if((', rcv, ') === nil || (', rcv, ') == null) {'.
-			self prvPutAndElse: [ self visit: aCollection first nodes first ].
-			self prvPutAndClose: [ self visit: aCollection second nodes first ].
-			inlined := true]].
-
-	(aSelector = 'ifNotNil:ifNil:') ifTrue: [
-		(aCollection first isBlockNode and: [aCollection second isBlockNode]) ifTrue: [ | rcv |
-			self aboutToModifyState.
-			rcv := self isolatedUse: anObject.
-			rcv = 'super' ifTrue: [ rcv := 'self' ].
-			self makeTargetRealVariable.
-			stream nextPutAll: 'if((', rcv, ') !!== nil && (', rcv, ') !!= null) {'.
-			self prvPutAndElse: [ self visit: aCollection first nodes first ].
-			self prvPutAndClose: [ self visit: aCollection second nodes first ].
-			inlined := true]].
-
-	(aSelector = 'isNil') ifTrue: [ | rcv |
-		rcv := self isolatedUse: anObject.
-		rcv = 'super' ifTrue: [ rcv := 'self' ].
-		self lazyAssignValue: '((', rcv, ') === nil || (', rcv, ') == null)'.
-		inlined := true].
-
-	(aSelector = 'notNil') ifTrue: [ | rcv |
-		rcv := self isolatedUse: anObject.
-		rcv = 'super' ifTrue: [ rcv := 'self' ].
-		self lazyAssignValue: '((', rcv, ') !!== nil && (', rcv, ') !!= null)'.
-		inlined := true].
-
-        ^inlined
-!
-
-isNode: aNode ofClass: aClass
-	^aNode isValueNode and: [
-          	aNode value class = aClass or: [
-          		aNode value = 'self' and: [self currentClass = aClass]]]
-!
-
-prvCheckClass: aClassName for: receiver
-	self makeTargetRealVariable.
-	self aboutToModifyState.
-        stream nextPutAll: 'if((', (self useValueNamed: receiver), ').klass === smalltalk.', aClassName, ') '
-!
-
-prvInlineNumberOperator: aSelector on: receiverNode and: operandNode
-	(aSelector = aSelector) ifTrue: [
-		(self isNode: receiverNode ofClass: Number) ifTrue: [
-			| rcv operand |
-			rcv := self isolated: receiverNode.
-			operand := self isolated: operandNode.
-			self lazyAssignValue: ((self useValueNamed: rcv), aSelector, (self useValueNamed: operand)).
-			^true]].
-	^false
-!
+inlineClosure: anIRClosure
+	"| inlinedClosure statements |
+
+	inlinedClosure := super inlineClosure: anIRClosure.
+	statements := inlinedClosure instructions last instructions.
+	
+	statements ifNotEmpty: [
+		statements last replaceWith: (IRNonLocalReturn new
+			add: statements last copy;
+			yourself) ].
+
+	^ inlinedClosure"
 
-prvWhileConditionStatement: stmtString pre: preString condition: anObject post: postString
-	| x |
-	stream nextPutAll: stmtString.
-	x := self isolatedUse: anObject nodes first.
-	x ifEmpty: [ x := '"should not reach - receiver includes ^"' ].
-	stream nextPutAll: preString, x, postString.
-	self nilIfValueWanted
+	^ super inlineCLosure: anIRClosure
 ! !
 
-!ImpCodeGenerator methodsFor: 'output'!
+IRSendInliner subclass: #IRReturnInliner
+	instanceVariableNames: ''
+	package:'Compiler'!
+!IRReturnInliner commentStamp!
+I inline message sends with inlined closure together with a return instruction.!
 
-mylf
-	^String lf, ((Array new: nestedBlocks+2)  join: String tab)
-!
+!IRReturnInliner methodsFor: '*Compiler'!
 
-prvPutAndClose: aBlock
+inlinedReturn
+	^ IRInlinedReturn new
+! !
 
-	aBlock value.
-	stream nextPutAll: '}', self mylf
-!
+!IRReturnInliner methodsFor: '*Compiler'!
 
-prvPutAndElse: aBlock
+inlineClosure: anIRClosure
+	| closure statements |
 
-	aBlock value.
-	stream nextPutAll: '} else {'
+	closure := super inlineClosure: anIRClosure.
+	statements := closure instructions last instructions.
+	
+	statements ifNotEmpty: [
+		statements last isReturn
+			ifFalse: [ statements last replaceWith: (IRReturn new
+				add: statements last copy;
+				yourself)] ].
+
+	^ closure
 !
 
-putTemps: temps
-    temps ifNotEmpty: [
-	stream nextPutAll: 'var '.
-	temps do: [:each | | temp |
-            temp := self safeVariableNameFor: each.
-	    tempVariables add: temp.
-	    stream nextPutAll: temp, '=nil'] separatedBy: [ stream nextPutAll: ',' ].
-	stream nextPutAll: ';', self mylf
-    ]
+inlineReturn: anIRReturn
+	| return |
+	return := self inlinedReturn.
+	anIRReturn instructions do: [ :each |
+		return add: each ].
+	anIRReturn replaceWith: return.
+	self inlineSend: return instructions last.
+	^ return
 ! !
 
-!ImpCodeGenerator methodsFor: 'testing'!
+CodeGenerator subclass: #InliningCodeGenerator
+	instanceVariableNames: ''
+	package:'Compiler'!
+!InliningCodeGenerator commentStamp!
+I am a specialized code generator that uses inlining to produce more optimized JavaScript output!
 
-assert: aBoolean
-	aBoolean ifFalse: [ self error: 'assertion failed' ]
-!
+!InliningCodeGenerator methodsFor: '*Compiler'!
 
-performOptimizations
-	^self class performOptimizations
-! !
+compileNode: aNode
+	| ir stream |
 
-!ImpCodeGenerator methodsFor: 'visiting'!
+	self semanticAnalyzer visit: aNode.
+	ir := self translator visit: aNode.
+	self inliner visit: ir.
 
-send: aSelector to: aReceiver arguments: aCollection superSend: aBoolean
-	| args |
-	args := self isolated: (DynamicArrayNode new nodes: aCollection; yourself).
-	self lazyAssignExpression: (String streamContents: [ :str |
-		str nextPutAll: 'smalltalk.send('.
-		str nextPutAll: (self useValueNamed: aReceiver).
-		str nextPutAll: ', "', aSelector asSelector, '", '.
-		str nextPutAll: (self useValueNamed: args).
-		aBoolean ifTrue: [
-			str nextPutAll: ', smalltalk.', (self classNameFor: self currentClass superclass)].
-		str nextPutAll: ')'
-	])
+	^ self irTranslator
+		visit: ir;
+		contents
 !
 
-sequenceOfNodes: nodes temps: temps
-	nodes isEmpty
-		ifFalse: [ | old index |
-			self putTemps: temps.
-			old :=self switchTarget: nil.
-			index := 0.
-			nodes do: [:each |
-				index := index + 1.
-				index = nodes size ifTrue: [ self switchTarget: old ].
-			self visit: each ]]
-		ifTrue: [ self nilIfValueWanted ]
+inliner
+	^ IRInliner new
 !
 
-visit: aNode
-	aNode accept: self
-!
+irTranslator
+	^ IRInliningJSTranslator new
+! !
 
-visitAssignmentNode: aNode
-| olds oldt |
-	olds := stream.
-	stream := '' writeStream.
-	oldt := self switchTarget: self nextLazyvarName.
-	self visit: aNode left.
-	self assert: (lazyVars at: target) ~= target.
-	self switchTarget: (self useValueNamed: (self switchTarget: nil)).
-	self assert: (lazyVars includesKey: target) not.
-	stream := olds.
-	self visit: aNode right.
-	olds := self switchTarget: oldt.
-	self ifValueWanted: [ self lazyAssignExpression: olds ]
-!
+NodeVisitor subclass: #AIContext
+	instanceVariableNames: 'outerContext pc locals receiver selector'
+	package:'Compiler'!
 
-visitBlockNode: aNode
-| oldt olds oldm |
-	self assert: aNode nodes size = 1.
-	oldt := self switchTarget: '^'.
-	olds := stream.
-	stream := '' writeStream.
-	stream nextPutAll: '(function('.
-	aNode parameters 
-	    do: [:each |
-		tempVariables add: each.
-		stream nextPutAll: each]
-	    separatedBy: [stream nextPutAll: ', '].
-	stream nextPutAll: '){'.
-	nestedBlocks := nestedBlocks + 1.
-	oldm := mutables.
-	mutables := Set new.
-	self visit: aNode nodes first.
-	self assert: mutables isEmpty.
-	mutables := oldm.
-	nestedBlocks := nestedBlocks - 1.
-	stream nextPutAll: '})'.
-	self switchTarget: oldt.
-	oldt := stream contents.
-	stream := olds.
-	self lazyAssignExpression: oldt
-!
+!AIContext methodsFor: '*Compiler'!
 
-visitBlockSequenceNode: aNode
-	self sequenceOfNodes: aNode nodes temps: aNode temps
+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 ]
 !
 
-visitCascadeNode: aNode
-	| rcv |
-	rcv := self isolated: aNode receiver.
-	self aboutToModifyState.
-	rcv := self useValueNamed: rcv.
-	aNode nodes do: [:each |
-		each receiver: (VerbatimNode new value: rcv) ].
-	self sequenceOfNodes: aNode nodes temps: #()
+locals
+	^ locals ifNil: [ locals := Dictionary new ]
 !
 
-visitClassReferenceNode: aNode
-	(referencedClasses includes: aNode value) ifFalse: [
-		referencedClasses add: aNode value].
-	self lazyAssignExpression: '(smalltalk.', aNode value, ' || ', aNode value, ')'
+outerContext
+	^ outerContext
 !
 
-visitDynamicArrayNode: aNode
-	| args |
-	args :=aNode nodes collect: [ :node | self isolated: node ].
-	self lazyAssignValue: (String streamContents: [ :str |
-		str nextPutAll: '['.
-		args
-	    		do: [:each | str nextPutAll: (self useValueNamed: each) ]
-	    		separatedBy: [str nextPutAll: ', '].
-                str nextPutAll: ']'
-	])
+outerContext: anAIContext
+	outerContext := anAIContext
 !
 
-visitDynamicDictionaryNode: aNode
-	| elements |
-	elements := self isolated: (DynamicArrayNode new nodes: aNode nodes; yourself).
-	self lazyAssignValue: 'smalltalk.HashedCollection._fromPairs_(', (self useValueNamed: elements), ')'
+pc
+	^ pc ifNil: [ pc := 0 ]
 !
 
-visitFailure: aFailure
-	self error: aFailure asString
+pc: anInteger
+	pc := anInteger
 !
 
-visitJSStatementNode: aNode
-	self aboutToModifyState.
-	stream nextPutAll: ';', (aNode source replace: '>>' with: '>'), ';', self mylf
+receiver
+	^ receiver
 !
 
-visitMethodNode: aNode
-	| str currentSelector | 
-	currentSelector := aNode selector asSelector.
-	nestedBlocks := 0.
-	earlyReturn := false.
-	messageSends := #().
-	referencedClasses := #().
-	unknownVariables := #().
-	tempVariables := #().
-	argVariables := #().
-	lazyVars := HashedCollection new.
-	mutables := Set new.
-	realVarNames := Set new.
-	stream 
-	    nextPutAll: 'smalltalk.method({'; lf;
-	    nextPutAll: 'selector: "', aNode selector, '",'; lf.
-	stream nextPutAll: 'source: ', self source asJavascript, ',';lf.
-	stream nextPutAll: 'fn: function('.
-	aNode arguments 
-	    do: [:each | 
-		argVariables add: each.
-		stream nextPutAll: each]
-	    separatedBy: [stream nextPutAll: ', '].
-	stream 
-	    nextPutAll: '){var self=this;', self mylf.
-	str := stream.
-	stream := '' writeStream.
-	self switchTarget: nil.
-	self assert: aNode nodes size = 1.
-	self visit: aNode nodes first.
-	realVarNames ifNotEmpty: [ str nextPutAll: 'var ', (realVarNames asArray join: ','), ';', self mylf ].
-	earlyReturn ifTrue: [
-	    str nextPutAll: 'var $early={}; try{', self mylf].
-	str nextPutAll: stream contents.
-	stream := str.
-	(aNode nodes first nodes notEmpty and: [ |checker|
-	    checker := ReturnNodeChecker new.
-	    checker visit: aNode nodes first nodes last.
-	    checker wasReturnNode]) ifFalse: [ self switchTarget: '^'. self lazyAssignValue: 'self'. self switchTarget: nil ].
-	earlyReturn ifTrue: [
-	    stream nextPutAll: '} catch(e) {if(e===$early) return e[0]; throw e}'].
-	stream nextPutAll: '}'.
-	stream 
-		nextPutAll: ',', String lf, 'messageSends: ';
-		nextPutAll: messageSends asJavascript, ','; lf;
-          	nextPutAll: 'args: ', argVariables asJavascript, ','; lf;
-		nextPutAll: 'referencedClasses: ['.
-	referencedClasses 
-		do: [:each | stream nextPutAll: each printString]
-		separatedBy: [stream nextPutAll: ','].
-	stream nextPutAll: ']'.
-	stream nextPutAll: '})'.
-	self assert: mutables isEmpty
+receiver: anObject
+	receiver := anObject
 !
 
-visitReturnNode: aNode
-	self assert: aNode nodes size = 1.
-	nestedBlocks > 0 ifTrue: [
-	    earlyReturn := true].
-	self
-		visit: aNode nodes first
-		targetBeing: (nestedBlocks > 0 ifTrue: ['!!'] ifFalse: ['^']).
-	self lazyAssignValue: ''
+selector
+	^ selector
 !
 
-visitSendNode: aNode
-        | receiver superSend rcv |
-        (messageSends includes: aNode selector) ifFalse: [
-                messageSends add: aNode selector].
-	
-	self performOptimizations 
-		ifTrue: [
-			(self inlineLiteral: aNode selector receiverNode: aNode receiver argumentNodes: aNode arguments) ifTrue: [ ^self ].
-		].
+selector: aString
+	selector := aString
+! !
 
-	rcv := self isolated: aNode receiver.
-        superSend := (lazyVars at: rcv ifAbsent: []) = 'super'.
-        superSend ifTrue: [ mutables remove: rcv. lazyVars at: rcv put: 'self' ].
+!AIContext class methodsFor: '*Compiler'!
 
-	self performOptimizations 
-		ifTrue: [ | inline |
-			inline := self inline: aNode selector receiver: rcv argumentNodes: aNode arguments.
-			inline ifNotNil: [ | args |
-				args := inline = true ifTrue: [ aNode arguments ] ifFalse: [ inline ].
-				self prvPutAndClose: [ self send: aNode selector to: rcv arguments: args superSend: superSend ].
-				^self ]].
-	self send: aNode selector to: rcv arguments: aNode arguments superSend: superSend
-!
+fromMethodContext: aMethodContext
+	^ self new 
+    	initializeFromMethodContext: aMethodContext;
+        yourself
+! !
 
-visitSequenceNode: aNode
-	aNode nodes isEmpty ifFalse: [
-		self sequenceOfNodes: aNode nodes temps: aNode temps ]
-!
+NodeVisitor subclass: #ASTInterpreter
+	instanceVariableNames: 'currentNode context shouldReturn'
+	package:'Compiler'!
 
-visitValueNode: aNode
-	self lazyAssignValue: aNode value asJavascript
-!
+!ASTInterpreter methodsFor: '*Compiler'!
 
-visitVariableNode: aNode
-	| varName |
-	(self currentClass allInstanceVariableNames includes: aNode value) 
-		ifTrue: [self lazyAssignExpression: 'self[''@', aNode value, ''']']
-		ifFalse: [
-                  	varName := self safeVariableNameFor: aNode value.
-			(self knownVariables includes: varName) 
-                  		ifFalse: [
-                                  	unknownVariables add: aNode value.
-                                  	aNode assigned 
-                                  		ifTrue: [self lazyAssignExpression: varName]
-                                  		ifFalse: [self lazyAssignExpression: '(typeof ', varName, ' == ''undefined'' ? nil : ', varName, ')']]
-                  		ifTrue: [
-                                  	aNode value = 'thisContext'
-                                  		ifTrue: [self lazyAssignExpression: '(smalltalk.getThisContext())']
-                				ifFalse: [(self pseudoVariables includes: varName)
-							ifTrue: [ self lazyAssignValue: varName ]
-							ifFalse: [ self lazyAssignExpression: varName]]]]
+context
+	^ context
 !
 
-visitVerbatimNode: aNode
-	self lazyAssignValue: aNode value
+context: anAIContext
+	context := anAIContext
+! !
+
+!ASTInterpreter methodsFor: '*Compiler'!
+
+initialize
+	super initialize.
+    shouldReturn := false
 ! !
 
-ImpCodeGenerator class instanceVariableNames: 'performOptimizations'!
+!ASTInterpreter methodsFor: '*Compiler'!
 
-!ImpCodeGenerator class methodsFor: 'accessing'!
+interpret: aNode
+	shouldReturn := false.
+    ^ self interpretNode: aNode
+!
 
-performOptimizations
-	^performOptimizations ifNil: [true]
+interpretNode: aNode
+	currentNode := aNode.
+    ^ self visit: aNode
 !
 
-performOptimizations: aBoolean
-	performOptimizations := aBoolean
+messageFromSendNode: aSendNode
+	^ Message new
+    	selector: aSendNode selector;
+        arguments: (aSendNode arguments collect: [ :each |
+        	self interpretNode: each ]);
+        yourself
 ! !
 
-NodeVisitor subclass: #ReturnNodeChecker
-	instanceVariableNames: 'wasReturnNode'
-	package: 'Compiler'!
+!ASTInterpreter methodsFor: '*Compiler'!
 
-!ReturnNodeChecker methodsFor: 'accessing'!
+visitBlockNode: aNode
+    ^ [ self interpretNode: aNode nodes first ]
+!
 
-wasReturnNode
-	^wasReturnNode
-! !
+visitCascadeNode: aNode
+	"TODO: Handle super sends"
+	| receiver |
+    
+    receiver := self interpretNode: aNode receiver.
 
-!ReturnNodeChecker methodsFor: 'initializing'!
+    aNode nodes allButLast
+    	do: [ :each | 
+        	(self messageFromSendNode: each)
+            	sendTo: receiver ].
 
-initialize
-	wasReturnNode := false
-! !
+    ^ (self messageFromSendNode: aNode nodes last)
+            	sendTo: receiver
+!
+
+visitClassReferenceNode: aNode
+	^ Smalltalk current at: aNode value
+!
 
-!ReturnNodeChecker methodsFor: 'visiting'!
+visitJSStatementNode: aNode
+	self halt
+!
 
 visitReturnNode: aNode
-	wasReturnNode := true
+	shouldReturn := true.
+    ^ self interpretNode: aNode nodes first
+!
+
+visitSendNode: aNode
+	"TODO: Handle super sends"
+    
+    ^ (self messageFromSendNode: aNode)
+    	sendTo: (self interpretNode: aNode receiver)
+!
+
+visitSequenceNode: aNode
+	aNode nodes allButLast do: [ :each | | value |
+        value := self interpretNode: each.
+		shouldReturn ifTrue: [ ^ value ] ].
+    ^ self interpretNode: aNode nodes last
+!
+
+visitValueNode: aNode
+	^ aNode value
 ! !
 

+ 20 - 8
st/Makefile

@@ -57,9 +57,18 @@ Kernel-Announcements.js: Kernel-Announcements.st boot.js init.js parser.js
 
 # ...and Compiler, but using the new Kernel from above.
 # We only need to depend on Kernel js files since it in turn depends on boot.js etc
+Compiler.st: Importer-Exporter.st Compiler-Exceptions.st Compiler-Core.st \
+    Compiler-AST.st Compiler-Semantic.st Compiler-IR.st Compiler-Inlining.st \
+    Compiler-Interpreter.st
+	echo "Smalltalk current createPackage: 'Compiler' properties: #{}!" >$@
+	sed -e '/^Smalltalk current createPackage:.*!$$/ d' \
+      -e 's/package: '"'[^':]*'"'!/package:'"'Compiler'"'!/' \
+      -e 's/ methodsFor: '"'[^']*'"'!$$/ methodsFor: '"'"'*Compiler'"'"'!/' \
+      $^ >>$@
+
 Compiler.js: Compiler.st Kernel-Objects.js Kernel-Classes.js Kernel-Methods.js Kernel-Collections.js \
 	Kernel-Exceptions.js Kernel-Transcript.js
-	$(AMBERC) $(FLAGS) $<
+	$(AMBERC) $(FLAGS) -l Importer-Exporter,Compiler-Exceptions,Compiler-Core,Compiler-AST,Compiler-Semantic,Compiler-IR,Compiler-Inlining $<
 
 # ...now that we have a new Kernel and Compiler we use them
 # to compile the rest of st files presuming that they only depend on Kernel, like
@@ -73,29 +82,32 @@ Compiler.js: Compiler.st Kernel-Objects.js Kernel-Classes.js Kernel-Methods.js K
 #
 # NOTE: With the new dependency model in class Package etc this will change!
 #
-Canvas.js: Canvas.st
+Canvas.js: Canvas.st Compiler.js
 	$(AMBERC) $(FLAGS) $<
 
 # IDE uses JQuery
-IDE.js: IDE.st Canvas.js
+IDE.js: IDE.st Canvas.js Compiler.js
 	$(AMBERC) $(FLAGS) -l Canvas $<
 
-TrySmalltalk.js: TrySmalltalk.st IDE.js
+TrySmalltalk.js: TrySmalltalk.st IDE.js Compiler.js
 	$(AMBERC) $(FLAGS) -l Canvas,IDE $<
 
 # Some Examples use SUnit and also IDE
-Examples.js: Examples.st SUnit.js IDE.js
+Examples.js: Examples.st SUnit.js IDE.js Compiler.js
 	$(AMBERC) $(FLAGS) -l SUnit,Canvas,IDE $<
 
 # Tests typically also use SUnit
-Kernel-Tests.js: Kernel-Tests.st SUnit.js
+Kernel-Tests.js: Kernel-Tests.st SUnit.js Compiler.js
+	$(AMBERC) $(FLAGS) -l SUnit $<
+
+Compiler-Tests.js: Compiler-Tests.st SUnit.js Compiler.js
 	$(AMBERC) $(FLAGS) -l SUnit $<
 
-Compiler-Tests.js: Compiler-Tests.st SUnit.js
+SUnit-Tests.js: SUnit-Tests.st SUnit.js Compiler.js
 	$(AMBERC) $(FLAGS) -l SUnit $<
 
 # Documentation
-Documentation.js: Documentation.st Canvas.js
+Documentation.js: Documentation.st Canvas.js Compiler.js
 	$(AMBERC) $(FLAGS) -l Canvas $<;
 
 # Installing is simply copying all js files to js directory.