amber/st/Compiler.st

Smalltalk current createPackage: 'Compiler' properties: #{}!
Object subclass: #ChunkParser
	instanceVariableNames: 'stream'
	package:'Compiler'!

!ChunkParser methodsFor: '*Compiler'!

stream: aStream
	stream := aStream
! !

!ChunkParser methodsFor: '*Compiler'!

nextChunk
	"The chunk format (Smalltalk Interchange Format or Fileout format)
	is a trivial format but can be a bit tricky to understand:
		- Uses the exclamation mark as delimiter of chunks.
		- Inside a chunk a normal exclamation mark must be doubled.
		- A non empty chunk must be a valid Smalltalk expression.
		- A chunk on top level with a preceding empty chunk is an instruction chunk:
			- The object created by the expression then takes over reading chunks.

	This metod returns next chunk as a String (trimmed), empty String (all whitespace) or nil."

	| char result chunk |
	result := '' writeStream.
        [char := stream next.
        char notNil] whileTrue: [
                 char = '!!' ifTrue: [
                         stream peek = '!!'
                                ifTrue: [stream next "skipping the escape double"]
                                ifFalse: [^result contents trimBoth  "chunk end marker found"]].
                 result nextPut: char].
	^nil "a chunk needs to end with !!"
! !

!ChunkParser class methodsFor: '*Compiler'!

on: aStream
	^self new stream: aStream
! !

Object subclass: #Exporter
	instanceVariableNames: ''
	package:'Compiler'!

!Exporter methodsFor: '*Compiler'!

exportAll
    "Export all packages in the system."

    ^String streamContents: [:stream |
    	Smalltalk current packages do: [:pkg |
		stream nextPutAll: (self exportPackage: pkg name)]]
!

exportClass: aClass
	"Export a single class. Subclasses override these methods."

	^String streamContents: [:stream |
		self exportDefinitionOf: aClass on: stream.
		self exportMethodsOf: aClass on: stream.
		self exportMetaDefinitionOf: aClass on: stream.
		self exportMethodsOf: aClass class on: stream]
!

exportPackage: packageName
	"Export a given package by name."

	| package |
	^String streamContents: [:stream |
                package := Smalltalk current packageAt: packageName.
                self exportPackageDefinitionOf: package on: stream.

		"Export classes in dependency order.
		Update (issue #171): Remove duplicates for export"
	    	package sortedClasses asSet do: [:each |
                        stream nextPutAll: (self exportClass: each)].
		self exportPackageExtensionsOf: package on: stream]
! !

!Exporter methodsFor: '*Compiler'!

classNameFor: aClass
	^aClass isMetaclass
	    ifTrue: [aClass instanceClass name, '.klass']
	    ifFalse: [
		aClass isNil
		    ifTrue: ['nil']
		    ifFalse: [aClass name]]
!

exportDefinitionOf: aClass on: aStream
	aStream 
	    nextPutAll: 'smalltalk.addClass(';
	    nextPutAll: '''', (self classNameFor: aClass), ''', ';
	    nextPutAll: 'smalltalk.', (self classNameFor: aClass superclass);
	    nextPutAll: ', ['.
	aClass instanceVariableNames 
	    do: [:each | aStream nextPutAll: '''', each, '''']
	    separatedBy: [aStream nextPutAll: ', '].
	aStream	
	    nextPutAll: '], ''';
	    nextPutAll: aClass category, '''';
	    nextPutAll: ');'.
	aClass comment notEmpty ifTrue: [
	    aStream 
	    	lf;
		nextPutAll: 'smalltalk.';
		nextPutAll: (self classNameFor: aClass);
		nextPutAll: '.comment=';
		nextPutAll: aClass comment asJavascript].
	aStream lf
!

exportMetaDefinitionOf: aClass on: aStream
	aClass class instanceVariableNames isEmpty ifFalse: [
	    aStream 
		nextPutAll: 'smalltalk.', (self classNameFor: aClass class);
		nextPutAll: '.iVarNames = ['.
	    aClass class instanceVariableNames
		do: [:each | aStream nextPutAll: '''', each, '''']
		separatedBy: [aStream nextPutAll: ','].
	    aStream nextPutAll: '];', String lf]
!

exportMethod: aMethod of: aClass on: aStream
	aStream 
		nextPutAll: 'smalltalk.addMethod(';lf;
		nextPutAll: aMethod selector asSelector asJavascript, ',';lf;
		nextPutAll: 'smalltalk.method({';lf;
		nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
		nextPutAll: 'category: ''', aMethod category, ''',';lf;
		nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
		nextPutAll: 'args: ', aMethod arguments asJavascript, ','; lf;
		nextPutAll: 'source: ', aMethod source asJavascript, ',';lf;
		nextPutAll: 'messageSends: ', aMethod messageSends asJavascript, ',';lf;
		nextPutAll: 'referencedClasses: ', aMethod referencedClasses asJavascript.
	aStream
		lf;
		nextPutAll: '}),';lf;
		nextPutAll: 'smalltalk.', (self classNameFor: aClass);
		nextPutAll: ');';lf;lf
!

exportMethodsOf: aClass on: aStream
	"Issue #143: sort methods alphabetically"

	((aClass methodDictionary values) sorted: [:a :b | a selector <= b selector]) do: [:each |
		(each category match: '^\*') ifFalse: [
			self exportMethod: each of: aClass on: aStream]].
	aStream lf
!

exportPackageDefinitionOf: package on: aStream
	aStream 
	    nextPutAll: 'smalltalk.addPackage(';
	    nextPutAll: '''', package name, ''', ', package propertiesAsJSON , ');'.
	aStream lf
!

exportPackageExtensionsOf: package on: aStream
	"Issue #143: sort classes and methods alphabetically"

	| name |
	name := package name.
	(Package sortedClasses: Smalltalk current classes) do: [:each |
		{each. each class} do: [:aClass | 
			((aClass methodDictionary values) sorted: [:a :b | a selector <= b selector]) do: [:method |
				(method category match: '^\*', name) ifTrue: [
					self exportMethod: method of: aClass on: aStream ]]]]
! !

Exporter subclass: #ChunkExporter
	instanceVariableNames: ''
	package:'Compiler'!

!ChunkExporter methodsFor: '*Compiler'!

chunkEscape: aString
	"Replace all occurrences of !! with !!!! and trim at both ends."

	^(aString replace: '!!' with: '!!!!') trimBoth
!

classNameFor: aClass
	^aClass isMetaclass
	    ifTrue: [aClass instanceClass name, ' class']
	    ifFalse: [
		aClass isNil
		    ifTrue: ['nil']
		    ifFalse: [aClass name]]
!

exportDefinitionOf: aClass on: aStream
    "Chunk format."

    aStream 
        nextPutAll: (self classNameFor: aClass superclass);
        nextPutAll: ' subclass: #', (self classNameFor: aClass); lf;
        nextPutAll: '	instanceVariableNames: '''.
    aClass instanceVariableNames 
        do: [:each | aStream nextPutAll: each]
        separatedBy: [aStream nextPutAll: ' '].
    aStream 
        nextPutAll: ''''; lf;
        nextPutAll: '	package: ''', aClass category, '''!!'; lf.
    aClass comment notEmpty ifTrue: [
        aStream 
        nextPutAll: '!!', (self classNameFor: aClass), ' commentStamp!!';lf;
        nextPutAll: (self chunkEscape: aClass comment), '!!';lf].
    aStream lf
!

exportMetaDefinitionOf: aClass on: aStream

	aClass class instanceVariableNames isEmpty ifFalse: [
		aStream 
		    nextPutAll: (self classNameFor: aClass class);
		    nextPutAll: ' instanceVariableNames: '''.
		aClass class instanceVariableNames 
		    do: [:each | aStream nextPutAll: each]
		    separatedBy: [aStream nextPutAll: ' '].
		aStream	
		    nextPutAll: '''!!'; lf; lf]
!

exportMethod: aMethod of: aClass on: aStream
	aStream 
		lf; lf; nextPutAll: (self chunkEscape: aMethod source); lf;
		nextPutAll: '!!'
!

exportMethods: methods category: category of: aClass on: aStream
	"Issue #143: sort methods alphabetically"

	aStream
		nextPutAll: '!!', (self classNameFor: aClass);
		nextPutAll: ' methodsFor: ''', category, '''!!'.
		(methods sorted: [:a :b | a selector <= b selector]) do: [:each |
				self exportMethod: each of: aClass on: aStream].
	aStream nextPutAll: ' !!'; lf; lf
!

exportMethodsOf: aClass on: aStream
	"Issue #143: sort protocol alphabetically"

	| map |
	map := Dictionary new.
	aClass protocolsDo: [:category :methods | 
		(category match: '^\*') ifFalse: [ map at: category put: methods ]].
	(map keys sorted: [:a :b | a <= b ]) do: [:category | | methods |
		methods := map at: category.
		self
			exportMethods: methods
			category: category
			of: aClass
			on: aStream ]
!

exportPackageDefinitionOf: package on: aStream
	"Chunk format."

	aStream 
	    nextPutAll: 'Smalltalk current createPackage: ''', package name,
		''' properties: ', package properties storeString, '!!'; lf.
!

exportPackageExtensionsOf: package on: aStream
	"We need to override this one too since we need to group
	all methods in a given protocol under a leading methodsFor: chunk
	for that class."

	"Issue #143: sort protocol alphabetically"

	| name map |
	name := package name.
	(Package sortedClasses: Smalltalk current classes) do: [:each |
		{each. each class} do: [:aClass |
			map := Dictionary new.
			aClass protocolsDo: [:category :methods | 
				(category match: '^\*', name) ifTrue: [ map at: category put: methods ]].
			(map keys sorted: [:a :b | a <= b ]) do: [:category | | methods |
				methods := map at: category.	
				self exportMethods: methods category: category of: aClass on: aStream ]]]
! !

Exporter subclass: #StrippedExporter
	instanceVariableNames: ''
	package:'Compiler'!

!StrippedExporter methodsFor: '*Compiler'!

exportDefinitionOf: aClass on: aStream
	aStream 
	    nextPutAll: 'smalltalk.addClass(';
	    nextPutAll: '''', (self classNameFor: aClass), ''', ';
	    nextPutAll: 'smalltalk.', (self classNameFor: aClass superclass);
	    nextPutAll: ', ['.
	aClass instanceVariableNames 
	    do: [:each | aStream nextPutAll: '''', each, '''']
	    separatedBy: [aStream nextPutAll: ', '].
	aStream	
	    nextPutAll: '], ''';
	    nextPutAll: aClass category, '''';
	    nextPutAll: ');'.
	aStream lf
!

exportMethod: aMethod of: aClass on: aStream
	aStream 
		nextPutAll: 'smalltalk.addMethod(';lf;
		nextPutAll: aMethod selector asSelector asJavascript, ',';lf;
		nextPutAll: 'smalltalk.method({';lf;
		nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
		nextPutAll: 'fn: ', aMethod fn compiledSource;lf;
		nextPutAll: '}),';lf;
		nextPutAll: 'smalltalk.', (self classNameFor: aClass);
		nextPutAll: ');';lf;lf
! !

Object subclass: #Importer
	instanceVariableNames: ''
	package:'Compiler'!

!Importer methodsFor: '*Compiler'!

import: aStream
    | chunk result parser lastEmpty |
    parser := ChunkParser on: aStream.
    lastEmpty := false.
    [chunk := parser nextChunk.
     chunk isNil] whileFalse: [
        chunk isEmpty
       		ifTrue: [lastEmpty := true]
       		ifFalse: [
        		result := Compiler new evaluateExpression: chunk.
        		lastEmpty 
            			ifTrue: [
                                  	lastEmpty := false.
                                  	result scanFrom: parser]]]
! !

Object subclass: #PackageLoader
	instanceVariableNames: ''
	package:'Compiler'!

!PackageLoader methodsFor: '*Compiler'!

initializePackageNamed: packageName prefix: aString

	(Package named: packageName) 
    	setupClasses;
        commitPathJs: '/', aString, '/js';
        commitPathSt: '/', aString, '/st'
!

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

loadPackages: aCollection prefix: aString
	aCollection do: [ :each |
    	self loadPackage: each prefix: aString ]
! !

!PackageLoader class methodsFor: '*Compiler'!

loadPackages: aCollection prefix: aString
	^ self new loadPackages: aCollection prefix: aString
! !

Error subclass: #CompilerError
	instanceVariableNames: ''
	package:'Compiler'!
!CompilerError commentStamp!
I am the common superclass of all compiling errors.!

CompilerError subclass: #ParseError
	instanceVariableNames: ''
	package:'Compiler'!
!ParseError commentStamp!
Instance of ParseError are signaled on any parsing error. 
See `Smalltalk >> #parse:`!

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.

The IDE should catch instances of Semantic error to deal with them when compiling!

SemanticError subclass: #InliningError
	instanceVariableNames: ''
	package:'Compiler'!
!InliningError commentStamp!
Instances of InliningError are signaled when using an `InliningCodeGenerator`in a `Compiler`.!

SemanticError subclass: #InvalidAssignmentError
	instanceVariableNames: 'variableName'
	package:'Compiler'!
!InvalidAssignmentError commentStamp!
I get signaled when a pseudo variable gets assigned.!

!InvalidAssignmentError methodsFor: '*Compiler'!

messageText
	^ ' Invalid assignment to variable: ', self variableName
!

variableName
	^ variableName
!

variableName: aString
	variableName := aString
! !

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

!ShadowingVariableError methodsFor: '*Compiler'!

messageText
	^ 'Variable shadowing error: ', self variableName, ' is already defined'
!

variableName
	^ variableName
!

variableName: aString
	variableName := aString
! !

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

!UnknownVariableError methodsFor: '*Compiler'!

variableName
	^ variableName
!

variableName: aString
	variableName := aString
! !

Object subclass: #Compiler
	instanceVariableNames: 'currentClass source unknownVariables codeGeneratorClass'
	package:'Compiler'!
!Compiler commentStamp!
I provide the public interface for compiling Amber source code into JavaScript.

The code generator used to produce JavaScript can be plugged with `#codeGeneratorClass`. 
The default code generator is an instance of `InlinedCodeGenerator`!

!Compiler methodsFor: '*Compiler'!

codeGeneratorClass
	^codeGeneratorClass ifNil: [InliningCodeGenerator]
!

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: '*Compiler'!

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: #().
	^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.
    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'!

accept: aVisitor
	^ aVisitor visitIRSend: self
! !

IRInstruction subclass: #IRSequence
	instanceVariableNames: ''
	package:'Compiler'!

!IRSequence methodsFor: '*Compiler'!

isSequence
	^ true
! !

!IRSequence methodsFor: '*Compiler'!

accept: aVisitor
	^ aVisitor visitIRSequence: self
! !

IRSequence subclass: #IRBlockSequence
	instanceVariableNames: ''
	package:'Compiler'!

!IRBlockSequence methodsFor: '*Compiler'!

accept: aVisitor
	^ aVisitor visitIRBlockSequence: self
! !

IRInstruction subclass: #IRValue
	instanceVariableNames: 'value'
	package:'Compiler'!
!IRValue commentStamp!
I am the simplest possible instruction. I represent a value.!

!IRValue methodsFor: '*Compiler'!

value
	^value
!

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
!

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
!

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
!

visitIRAssignment: anIRAssignment
	^ self visitIRInstruction: anIRAssignment
!

visitIRBlockReturn: anIRBlockReturn
	^ self visitIRReturn: anIRBlockReturn
!

visitIRBlockSequence: anIRBlockSequence
	^ self visitIRSequence: anIRBlockSequence
!

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

IRVisitor subclass: #IRJSTranslator
	instanceVariableNames: 'stream'
	package:'Compiler'!

!IRJSTranslator methodsFor: '*Compiler'!

contents
	^ self stream contents
!

stream
	^ stream
!

stream: aStream
	stream := aStream
! !

!IRJSTranslator methodsFor: '*Compiler'!

initialize
	super initialize.
	stream := JSStream new.
! !

!IRJSTranslator methodsFor: '*Compiler'!

visitIRAssignment: anIRAssignment
	self visit: anIRAssignment instructions first.
	self stream nextPutAssignment.
	self visit: anIRAssignment instructions last.
!

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

Object subclass: #JSStream
	instanceVariableNames: 'stream'
	package:'Compiler'!

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

!IRInlinedAssignment methodsFor: '*Compiler'!

accept: aVisitor
	^ aVisitor visitIRInlinedAssignment: self
! !

IRClosure subclass: #IRInlinedClosure
	instanceVariableNames: ''
	package:'Compiler'!
!IRInlinedClosure commentStamp!
I represent an inlined closure instruction.!

!IRInlinedClosure methodsFor: '*Compiler'!

isInlined
	^ true
! !

!IRInlinedClosure methodsFor: '*Compiler'!

accept: aVisitor
	aVisitor visitIRInlinedClosure: self
! !

IRReturn subclass: #IRInlinedReturn
	instanceVariableNames: ''
	package:'Compiler'!
!IRInlinedReturn commentStamp!
I represent an inlined local return instruction.!

!IRInlinedReturn methodsFor: '*Compiler'!

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

!IRInlinedSend methodsFor: '*Compiler'!

isInlined
	^ true
! !

!IRInlinedSend methodsFor: '*Compiler'!

accept: aVisitor
	aVisitor visitInlinedSend: self
! !

IRInlinedSend subclass: #IRInlinedIfFalse
	instanceVariableNames: ''
	package:'Compiler'!

!IRInlinedIfFalse methodsFor: '*Compiler'!

accept: aVisitor
	aVisitor visitIRInlinedIfFalse: self
! !

IRInlinedSend subclass: #IRInlinedIfNilIfNotNil
	instanceVariableNames: ''
	package:'Compiler'!

!IRInlinedIfNilIfNotNil methodsFor: '*Compiler'!

accept: aVisitor
	aVisitor visitIRInlinedIfNilIfNotNil: self
! !

IRInlinedSend subclass: #IRInlinedIfTrue
	instanceVariableNames: ''
	package:'Compiler'!

!IRInlinedIfTrue methodsFor: '*Compiler'!

accept: aVisitor
	aVisitor visitIRInlinedIfTrue: self
! !

IRInlinedSend subclass: #IRInlinedIfTrueIfFalse
	instanceVariableNames: ''
	package:'Compiler'!

!IRInlinedIfTrueIfFalse methodsFor: '*Compiler'!

accept: aVisitor
	aVisitor visitIRInlinedIfTrueIfFalse: self
! !

IRBlockSequence subclass: #IRInlinedSequence
	instanceVariableNames: ''
	package:'Compiler'!
!IRInlinedSequence commentStamp!
I represent a (block) sequence inside an inlined closure instruction (instance of `IRInlinedClosure`).!

!IRInlinedSequence methodsFor: '*Compiler'!

isInlined
	^ true
! !

!IRInlinedSequence methodsFor: '*Compiler'!

accept: aVisitor
	aVisitor visitIRInlinedSequence: self
! !

IRVisitor subclass: #IRInliner
	instanceVariableNames: ''
	package:'Compiler'!
!IRInliner commentStamp!
I visit an IR tree, inlining message sends and block closures.

Message selectors that can be inlined are answered by `IRSendInliner >> #inlinedSelectors`!

!IRInliner methodsFor: '*Compiler'!

assignmentInliner
	^ IRAssignmentInliner new 
		translator: self;
		yourself
!

nonLocalReturnInliner
	^ IRNonLocalReturnInliner new 
		translator: self;
		yourself
!

returnInliner
	^ IRReturnInliner new 
		translator: self;
		yourself
!

sendInliner
	^ IRSendInliner new 
		translator: self;
		yourself
! !

!IRInliner methodsFor: '*Compiler'!

shouldInlineAssignment: anIRAssignment
	^ anIRAssignment isInlined not and: [ 
		anIRAssignment instructions last isSend and: [	
			self shouldInlineSend: (anIRAssignment instructions last) ]]
!

shouldInlineReturn: anIRReturn
	^ anIRReturn isInlined not and: [ 
		anIRReturn instructions first isSend and: [	
			self shouldInlineSend: (anIRReturn instructions first) ]]
!

shouldInlineSend: anIRSend
	^ anIRSend isInlined not and: [
		IRSendInliner shouldInline: anIRSend ]
! !

!IRInliner methodsFor: '*Compiler'!

transformNonLocalReturn: anIRNonLocalReturn
	"Replace a non local return into a local return"

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

visitIRAssignment: anIRAssignment
	^ (self shouldInlineAssignment: anIRAssignment) 
		ifTrue: [ self assignmentInliner inlineAssignment: anIRAssignment ]
		ifFalse: [ super visitIRAssignment: anIRAssignment ]
!

visitIRNonLocalReturn: anIRNonLocalReturn
	^ (self shouldInlineReturn: anIRNonLocalReturn) 
		ifTrue: [ self nonLocalReturnInliner inlineReturn: anIRNonLocalReturn ]
		ifFalse: [ self transformNonLocalReturn: anIRNonLocalReturn ]
!

visitIRReturn: anIRReturn
	^ (self shouldInlineReturn: anIRReturn) 
		ifTrue: [ self returnInliner inlineReturn: anIRReturn ]
		ifFalse: [ super visitIRReturn: anIRReturn ]
!

visitIRSend: anIRSend
	^ (self shouldInlineSend: anIRSend)
		ifTrue: [ self sendInliner inlineSend: anIRSend ]
		ifFalse: [ super visitIRSend: anIRSend ]
! !

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

!IRInliningJSTranslator methodsFor: '*Compiler'!

visitIRInlinedAssignment: anIRInlinedAssignment
	self visit: anIRInlinedAssignment instructions last
!

visitIRInlinedClosure: anIRInlinedClosure
	anIRInlinedClosure instructions do: [ :each |
		self visit: each ]
!

visitIRInlinedIfFalse: anIRInlinedIfFalse
	self stream nextPutIf: [ 
		self stream nextPutAll: '!! smalltalk.assert('.
		self visit: anIRInlinedIfFalse instructions first.
		self stream nextPutAll: ')' ]
		with: [ self visit: anIRInlinedIfFalse instructions last ]
!

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

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

visitIRInlinedIfTrue: anIRInlinedIfTrue
	self stream nextPutIf: [ 
		self stream nextPutAll: 'smalltalk.assert('. 
		self visit: anIRInlinedIfTrue instructions first.
		self stream nextPutAll: ')' ]
		with: [ self visit: anIRInlinedIfTrue instructions last ]
!

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: [ ]
!

visitIRInlinedReturn: anIRInlinedReturn
	self visit: anIRInlinedReturn instructions last
!

visitIRInlinedSequence: anIRInlinedSequence
	anIRInlinedSequence instructions do: [ :each | 
		self stream nextPutStatementWith: [ self visit: each ]]
! !

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

!IRSendInliner methodsFor: '*Compiler'!

send
	^ send
!

send: anIRSend
	send := anIRSend
!

translator
	^ translator
!

translator: anASTTranslator
	translator := anASTTranslator
! !

!IRSendInliner methodsFor: '*Compiler'!

inliningError: aString
	InliningError signal: aString
! !

!IRSendInliner methodsFor: '*Compiler'!

inlinedClosure
	^ IRInlinedClosure new
!

inlinedSequence
	^ IRInlinedSequence new
! !

!IRSendInliner methodsFor: '*Compiler'!

ifFalse: anIRInstruction
	^ self inlinedSend: IRInlinedIfFalse new with: anIRInstruction
!

ifFalse: anIRInstruction ifTrue: anotherIRInstruction
	^ self perform: #ifTrue:ifFalse: withArguments: { anotherIRInstruction. anIRInstruction }
!

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

ifNil: anIRInstruction ifNotNil: anotherIRInstruction
	^ self inlinedSend: IRInlinedIfNilIfNotNil new with: anIRInstruction with: anotherIRInstruction
!

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
!

ifNotNil: anIRInstruction ifNil: anotherIRInstruction
	^ self inlinedSend: IRInlinedIfNilIfNotNil new with: anotherIRInstruction with: anIRInstruction
!

ifTrue: anIRInstruction
	^ self inlinedSend: IRInlinedIfTrue new with: anIRInstruction
!

ifTrue: anIRInstruction ifFalse: anotherIRInstruction
	^ self inlinedSend: IRInlinedIfTrueIfFalse new with: anIRInstruction with: anotherIRInstruction
!

inlineClosure: anIRClosure
	| inlinedClosure sequence statements |

	inlinedClosure := self inlinedClosure.
	inlinedClosure scope: anIRClosure scope.

	"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.
	
	statements ifNotEmpty: [
		statements allButLast do: [ :each | sequence add: each ].

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

inlineSend: anIRSend
	self send: anIRSend.
	^ self 
		perform: self send selector 
		withArguments: self send instructions allButFirst
!

inlinedSend: inlinedSend with: anIRInstruction
	| inlinedClosure |

	anIRInstruction isClosure ifFalse: [ self inliningError: 'Message argument should be a block' ].
	anIRInstruction arguments size = 0 ifFalse: [ self inliningError: 'Inlined block should have zero argument' ].

	inlinedClosure := self translator visit: (self inlineClosure: anIRInstruction).

	inlinedSend
		add: self send instructions first;
		add: inlinedClosure.

	self send replaceWith: inlinedSend.

	^ inlinedSend
!

inlinedSend: inlinedSend with: anIRInstruction with: anotherIRInstruction
	| inlinedClosure1 inlinedClosure2 |

	anIRInstruction isClosure ifFalse: [ self inliningError: 'Message argument should be a block' ].
	anIRInstruction arguments size = 0 ifFalse: [ self inliningError: 'Inlined block should have zero argument' ].

	anotherIRInstruction isClosure ifFalse: [ self inliningError: 'Message argument should be a block' ].
	anotherIRInstruction arguments size = 0 ifFalse: [ self inliningError: 'Inlined block should have zero argument' ].

	inlinedClosure1 := self translator visit: (self inlineClosure: anIRInstruction).
	inlinedClosure2 := self translator visit: (self inlineClosure: anotherIRInstruction).


	inlinedSend
		add: self send instructions first;
		add: inlinedClosure1;
		add: inlinedClosure2.

	self send replaceWith: inlinedSend.
	^ inlinedSend
! !

!IRSendInliner class methodsFor: '*Compiler'!

inlinedSelectors
	^ #('ifTrue:' 'ifFalse:' 'ifTrue:ifFalse:' 'ifFalse:ifTrue:' 'ifNil:' 'ifNotNil:' 'ifNil:ifNotNil:' 'ifNotNil:ifNil')
!

shouldInline: anIRInstruction
	(self inlinedSelectors includes: anIRInstruction selector) ifFalse: [ ^ false ].
	anIRInstruction instructions allButFirst do: [ :each |
		each isClosure ifFalse: [ ^ false ]].
	^ true
! !

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. 

##Example

	foo
		| a |
		a := true ifTrue: [ 1 ]

Will produce:

	if(smalltalk.assert(true) {
		a = 1;
	};!

!IRAssignmentInliner methodsFor: '*Compiler'!

assignment
	^ assignment
!

assignment: aNode
	assignment := aNode
! !

!IRAssignmentInliner methodsFor: '*Compiler'!

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
!

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) ] ].

	^ inlinedClosure
! !

IRSendInliner subclass: #IRNonLocalReturnInliner
	instanceVariableNames: ''
	package:'Compiler'!

!IRNonLocalReturnInliner methodsFor: '*Compiler'!

inlinedReturn
	^ IRInlinedNonLocalReturn new
! !

!IRNonLocalReturnInliner methodsFor: '*Compiler'!

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"

	^ super inlineCLosure: anIRClosure
! !

IRSendInliner subclass: #IRReturnInliner
	instanceVariableNames: ''
	package:'Compiler'!
!IRReturnInliner commentStamp!
I inline message sends with inlined closure together with a return instruction.!

!IRReturnInliner methodsFor: '*Compiler'!

inlinedReturn
	^ IRInlinedReturn new
! !

!IRReturnInliner methodsFor: '*Compiler'!

inlineClosure: anIRClosure
	| closure statements |

	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
!

inlineReturn: anIRReturn
	| return |
	return := self inlinedReturn.
	anIRReturn instructions do: [ :each |
		return add: each ].
	anIRReturn replaceWith: return.
	self inlineSend: return instructions last.
	^ return
! !

CodeGenerator subclass: #InliningCodeGenerator
	instanceVariableNames: ''
	package:'Compiler'!
!InliningCodeGenerator commentStamp!
I am a specialized code generator that uses inlining to produce more optimized JavaScript output!

!InliningCodeGenerator methodsFor: '*Compiler'!

compileNode: aNode
	| ir stream |

	self semanticAnalyzer visit: aNode.
	ir := self translator visit: aNode.
	self inliner visit: ir.

	^ self irTranslator
		visit: ir;
		contents
!

inliner
	^ IRInliner new
!

irTranslator
	^ IRInliningJSTranslator new
! !

NodeVisitor subclass: #AIContext
	instanceVariableNames: 'outerContext pc locals receiver selector'
	package:'Compiler'!

!AIContext methodsFor: '*Compiler'!

initializeFromMethodContext: aMethodContext
	self pc: aMethodContext pc.
    self receiver: aMethodContext receiver.
    self selector: aMethodContext selector.
    aMethodContext outerContext ifNotNil: [
		self outerContext: (self class fromMethodContext: aMethodContext outerContext) ].
    aMethodContext locals keysAndValuesDo: [ :key :value |
    	self locals at: key put: value ]
!

locals
	^ locals ifNil: [ locals := Dictionary new ]
!

outerContext
	^ outerContext
!

outerContext: anAIContext
	outerContext := anAIContext
!

pc
	^ pc ifNil: [ pc := 0 ]
!

pc: anInteger
	pc := anInteger
!

receiver
	^ receiver
!

receiver: anObject
	receiver := anObject
!

selector
	^ selector
!

selector: aString
	selector := aString
! !

!AIContext class methodsFor: '*Compiler'!

fromMethodContext: aMethodContext
	^ self new 
    	initializeFromMethodContext: aMethodContext;
        yourself
! !

NodeVisitor subclass: #ASTInterpreter
	instanceVariableNames: 'currentNode context shouldReturn'
	package:'Compiler'!

!ASTInterpreter methodsFor: '*Compiler'!

context
	^ context
!

context: anAIContext
	context := anAIContext
! !

!ASTInterpreter methodsFor: '*Compiler'!

initialize
	super initialize.
    shouldReturn := false
! !

!ASTInterpreter methodsFor: '*Compiler'!

interpret: aNode
	shouldReturn := false.
    ^ self interpretNode: aNode
!

interpretNode: aNode
	currentNode := aNode.
    ^ self visit: aNode
!

messageFromSendNode: aSendNode
	^ Message new
    	selector: aSendNode selector;
        arguments: (aSendNode arguments collect: [ :each |
        	self interpretNode: each ]);
        yourself
! !

!ASTInterpreter methodsFor: '*Compiler'!

visitBlockNode: aNode
    ^ [ self interpretNode: aNode nodes first ]
!

visitCascadeNode: aNode
	"TODO: Handle super sends"
	| receiver |
    
    receiver := self interpretNode: aNode receiver.

    aNode nodes allButLast
    	do: [ :each | 
        	(self messageFromSendNode: each)
            	sendTo: receiver ].

    ^ (self messageFromSendNode: aNode nodes last)
            	sendTo: receiver
!

visitClassReferenceNode: aNode
	^ Smalltalk current at: aNode value
!

visitJSStatementNode: aNode
	self halt
!

visitReturnNode: aNode
	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
! !