Smalltalk current createPackage: 'Compiler-Core' properties: #{}! Object subclass: #Compiler instanceVariableNames: 'currentClass source unknownVariables codeGeneratorClass' package: 'Compiler-Core'! !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: 'accessing'! 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: '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: #(). ^result ! 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 | 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 ! ! !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-Core'! !DoIt commentStamp! `DoIt` is the class used to compile and evaluate expressions. See `Compiler >> evaluateExpression:`.! Object subclass: #NodeVisitor instanceVariableNames: '' package: 'Compiler-Core'! !NodeVisitor commentStamp! I am the abstract super class of all AST node visitors.! !NodeVisitor methodsFor: 'visiting'! 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-Core'! !AbstractCodeGenerator commentStamp! I am the abstract super class of all code generators and provide their common API.! !AbstractCodeGenerator methodsFor: 'accessing'! 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: 'compiling'! compileNode: aNode self subclassResponsibility ! ! AbstractCodeGenerator subclass: #CodeGenerator instanceVariableNames: '' package: 'Compiler-Core'! !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: 'compiling'! 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 ! ! AbstractCodeGenerator subclass: #FunCodeGenerator instanceVariableNames: 'stream nestedBlocks earlyReturn currentSelector unknownVariables tempVariables messageSends referencedClasses classReferenced argVariables' package: 'Compiler-Core'! !FunCodeGenerator methodsFor: 'accessing'! argVariables ^argVariables copy ! knownVariables ^self pseudoVariables addAll: self tempVariables; addAll: self argVariables; yourself ! tempVariables ^tempVariables copy ! unknownVariables ^unknownVariables copy ! ! !FunCodeGenerator methodsFor: 'compiling'! compileNode: aNode stream := '' writeStream. self visit: aNode. ^stream contents ! ! !FunCodeGenerator methodsFor: 'initialization'! 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: ')'] ! visit: aNode aNode accept: self ! visitAssignmentNode: aNode stream nextPutAll: '('. self visit: aNode left. stream nextPutAll: '='. self visit: aNode right. stream nextPutAll: ')' ! 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: '})' ! 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 ! 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: ')' ! visitClassReferenceNode: aNode (referencedClasses includes: aNode value) ifFalse: [ referencedClasses add: aNode value]. stream nextPutAll: '(smalltalk.', aNode value, ' || ', aNode value, ')' ! visitDynamicArrayNode: aNode stream nextPutAll: '['. aNode nodes do: [:each | self visit: each] separatedBy: [stream nextPutAll: ',']. stream nextPutAll: ']' ! visitDynamicDictionaryNode: aNode stream nextPutAll: 'smalltalk.HashedCollection._fromPairs_(['. aNode nodes do: [:each | self visit: each] separatedBy: [stream nextPutAll: ',']. stream nextPutAll: '])' ! visitFailure: aFailure self error: aFailure asString ! visitJSStatementNode: aNode stream nextPutAll: aNode source ! 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: '})' ! 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: ']})()'] ! 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. 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)] ! 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] ! visitValueNode: aNode stream nextPutAll: aNode value asJavascript ! 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]]] ! ! FunCodeGenerator class instanceVariableNames: 'performOptimizations'! !FunCodeGenerator class methodsFor: 'accessing'! performOptimizations ^performOptimizations ifNil: [true] ! performOptimizations: aBoolean performOptimizations := aBoolean ! !