Object subclass: #Node instanceVariableNames: 'nodes' category: 'Compiler'! !Node methodsFor: 'accessing'! nodes ^nodes ifNil: [nodes := Array new] ! addNode: aNode self nodes add: aNode ! ! !Node methodsFor: 'building'! nodes: aCollection nodes := aCollection ! ! !Node methodsFor: 'visiting'! accept: aVisitor aVisitor visitNode: self ! ! Node subclass: #MethodNode instanceVariableNames: 'selector arguments source' category: 'Compiler'! !MethodNode methodsFor: 'accessing'! selector ^selector ! selector: aString selector := aString ! arguments ^arguments ifNil: [#()] ! arguments: aCollection arguments := aCollection ! source ^source ! source: aString source := aString ! ! !MethodNode methodsFor: 'visiting'! accept: aVisitor aVisitor visitMethodNode: self ! ! Node subclass: #SendNode instanceVariableNames: 'selector arguments receiver' category: 'Compiler'! !SendNode methodsFor: 'accessing'! selector ^selector ! selector: aString selector := aString ! arguments ^arguments ifNil: [arguments := #()] ! arguments: aCollection arguments := aCollection ! receiver ^receiver ! receiver: aNode receiver := aNode ! valueForReceiver: anObject ^SendNode new receiver: (self receiver ifNil: [anObject] ifNotNil: [self receiver valueForReceiver: anObject]); selector: self selector; arguments: self arguments; yourself ! cascadeNodeWithMessages: aCollection | first | first := SendNode new selector: self selector; arguments: self arguments; yourself. ^CascadeNode new receiver: self receiver; nodes: (Array with: first), aCollection; yourself ! ! !SendNode methodsFor: 'visiting'! accept: aVisitor aVisitor visitSendNode: self ! ! Node subclass: #CascadeNode instanceVariableNames: 'receiver' category: 'Compiler'! !CascadeNode methodsFor: 'accessing'! receiver ^receiver ! receiver: aNode receiver := aNode ! ! !CascadeNode methodsFor: 'visiting'! accept: aVisitor aVisitor visitCascadeNode: self ! ! Node subclass: #AssignmentNode instanceVariableNames: 'left right' category: 'Compiler'! !AssignmentNode methodsFor: 'accessing'! left ^left ! left: aNode left := aNode ! right ^right ! right: aNode right := aNode ! ! !AssignmentNode methodsFor: 'visiting'! accept: aVisitor aVisitor visitAssignmentNode: self ! ! Node subclass: #BlockNode instanceVariableNames: 'parameters' category: 'Compiler'! !BlockNode methodsFor: 'accessing'! parameters ^parameters ifNil: [parameters := Array new] ! parameters: aCollection parameters := aCollection ! ! !BlockNode methodsFor: 'visiting'! accept: aVisitor aVisitor visitBlockNode: self ! ! Node subclass: #SequenceNode instanceVariableNames: 'temps' category: 'Compiler'! !SequenceNode methodsFor: 'accessing'! temps ^temps ifNil: [#()] ! temps: aCollection temps := aCollection ! ! !SequenceNode methodsFor: 'testing'! asBlockSequenceNode ^BlockSequenceNode new nodes: self nodes; temps: self temps; yourself ! ! !SequenceNode methodsFor: 'visiting'! accept: aVisitor aVisitor visitSequenceNode: self ! ! SequenceNode subclass: #BlockSequenceNode instanceVariableNames: '' category: 'Compiler'! !BlockSequenceNode methodsFor: 'visiting'! accept: aVisitor aVisitor visitBlockSequenceNode: self ! ! Node subclass: #ReturnNode instanceVariableNames: '' category: 'Compiler'! !ReturnNode methodsFor: 'visiting'! accept: aVisitor aVisitor visitReturnNode: self ! ! Node subclass: #ValueNode instanceVariableNames: 'value' category: 'Compiler'! !ValueNode methodsFor: 'accessing'! value ^value ! value: anObject value := anObject ! ! !ValueNode methodsFor: 'visiting'! accept: aVisitor aVisitor visitValueNode: self ! ! ValueNode subclass: #VariableNode instanceVariableNames: '' category: 'Compiler'! !VariableNode methodsFor: 'visiting'! accept: aVisitor aVisitor visitVariableNode: self ! ! VariableNode subclass: #ClassReferenceNode instanceVariableNames: '' category: 'Compiler'! !ClassReferenceNode methodsFor: 'visiting'! accept: aVisitor aVisitor visitClassReferenceNode: self ! ! Node subclass: #JSStatementNode instanceVariableNames: 'source' category: 'Compiler'! !JSStatementNode methodsFor: 'accessing'! source ^source ifNil: [''] ! source: aString source := aString ! ! !JSStatementNode methodsFor: 'visiting'! accept: aVisitor aVisitor visitJSStatementNode: self ! ! Object subclass: #NodeVisitor instanceVariableNames: '' category: 'Compiler'! !NodeVisitor methodsFor: 'visiting'! visit: aNode aNode accept: self ! visitNode: aNode ! visitMethodNode: aNode self visitNode: aNode ! visitSequenceNode: aNode self visitNode: aNode ! visitBlockSequenceNode: aNode self visitSequenceNode: aNode ! visitBlockNode: aNode self visitNode: aNode ! visitReturnNode: aNode self visitNode: aNode ! visitSendNode: aNode self visitNode: aNode ! visitCascadeNode: aNode self visitNode: aNode ! visitValueNode: aNode self visitNode: aNode ! visitVariableNode: aNode ! visitAssignmentNode: aNode self visitNode: aNode ! visitClassReferenceNode: aNode self nextPutAll: 'smalltalk.'; nextPutAll: aNode value ! visitJSStatementNode: aNode self nextPutAll: 'function(){'; nextPutAll: aNode source; nextPutAll: '})()' ! ! NodeVisitor subclass: #Compiler instanceVariableNames: 'stream nestedBlocks earlyReturn currentClass currentSelector unknownVariables tempVariables messageSends referencedClasses' category: 'Compiler'! !Compiler methodsFor: 'accessing'! parser ^SmalltalkParser new ! currentClass ^currentClass ! currentClass: aClass currentClass := aClass ! unknownVariables ^unknownVariables copy ! pseudoVariables ^#('self' 'super' 'true' 'false' 'nil' 'thisContext') ! tempVariables ^tempVariables copy ! knownVariables ^self pseudoVariables addAll: self tempVariables; yourself ! classNameFor: aClass ^aClass isMetaclass ifTrue: [aClass instanceClass name, '.klass'] ifFalse: [ aClass isNil ifTrue: ['nil'] ifFalse: [aClass name]] ! ! !Compiler methodsFor: 'compiling'! loadExpression: aString DoIt addCompiledMethod: (self eval: (self compileExpression: aString)). ^DoIt new doIt ! load: aString forClass: aClass | compiled | compiled := self eval: (self compile: aString forClass: aClass). self setupClass: aClass. ^compiled ! compile: aString forClass: aClass self currentClass: aClass. ^self compile: aString ! compileExpression: aString self currentClass: DoIt. ^self compileNode: (self parseExpression: aString) ! eval: aString ! compile: aString ^self compileNode: (self parse: aString) ! compileNode: aNode stream := '' writeStream. self visit: aNode. ^stream contents ! parse: aString ^self parser parse: aString readStream ! parseExpression: aString ^self parse: 'doIt ^[', aString, '] value' ! recompile: aClass aClass methodDictionary do: [:each || method | method := self load: each source forClass: aClass. method category: each category. aClass addCompiledMethod: method]. 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 methodsFor: 'initialization'! initialize super initialize. stream := '' writeStream. unknownVariables := #(). tempVariables := #(). messageSends := #(). classReferenced := #() ! ! !Compiler methodsFor: 'visiting'! visit: aNode aNode accept: self ! visitMethodNode: aNode | str currentSelector | currentSelector := aNode selector asSelector. nestedBlocks := 0. earlyReturn := false. messageSends := #(). referencedClasses := #(). unknownVariables := #(). tempVariables := #(). stream nextPutAll: 'smalltalk.method({'; lf; nextPutAll: 'selector: "', aNode selector, '",'; lf. stream nextPutAll: 'source: unescape("', aNode source escaped, '"),';lf. stream nextPutAll: 'fn: function('. aNode arguments do: [:each | tempVariables 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: 'try{']. str nextPutAll: stream contents. stream := str. stream lf; nextPutAll: 'return self;'. earlyReturn ifTrue: [ stream lf; nextPutAll: '} catch(e) {if(e.name === ''stReturn'' && e.selector === ', currentSelector printString, '){return e.fn()} throw(e)}']. stream nextPutAll: '}'. stream nextPutAll: ',', String lf, 'messageSends: '; nextPutAll: messageSends asJavascript, ','; lf; nextPutAll: 'referencedClasses: ['. referencedClasses do: [:each | stream nextPutAll: each] separatedBy: [stream nextPutAll: ',']. stream nextPutAll: ']'. 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: '})' ! visitSequenceNode: aNode aNode temps do: [:each | tempVariables add: each. stream nextPutAll: 'var ', each, '=nil;'; lf]. aNode nodes do: [:each | self visit: each. stream nextPutAll: ';'] separatedBy: [stream lf] ! visitBlockSequenceNode: aNode | index | nestedBlocks := nestedBlocks + 1. aNode nodes isEmpty ifTrue: [ stream nextPutAll: 'return nil;'] ifFalse: [ aNode temps do: [:each | tempVariables add: each. stream nextPutAll: 'var ', each, '=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 ! visitReturnNode: aNode nestedBlocks > 0 ifTrue: [ earlyReturn := true]. earlyReturn ifTrue: [ stream nextPutAll: '(function(){throw('; nextPutAll: '{name: ''stReturn'', selector: '; nextPutAll: currentSelector printString; nextPutAll: ', fn: function(){return '] ifFalse: [stream nextPutAll: 'return ']. aNode nodes do: [:each | self visit: each]. earlyReturn ifTrue: [ stream nextPutAll: '}})})()'] ! visitSendNode: aNode | str receiver superSend | 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]. str nextPutAll: 'smalltalk.send('. str nextPutAll: receiver. stream := str. stream nextPutAll: ', "', aNode selector asSelector, '", ['. aNode arguments do: [:each | self visit: each] separatedBy: [stream nextPutAll: ', ']. stream nextPutAll: ']'. superSend ifTrue: [ stream nextPutAll: ', smalltalk.', (self classNameFor: self currentClass superclass)]. stream nextPutAll: ')' ! 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: ')' ! visitValueNode: aNode stream nextPutAll: aNode value asJavascript ! visitAssignmentNode: aNode self visit: aNode left. stream nextPutAll: '='. self visit: aNode right ! visitClassReferenceNode: aNode | klass | klass := 'smalltalk.', aNode value. (Smalltalk current at: aNode value) isClass ifTrue: [ (referencedClasses includes: klass) ifFalse: [referencedClasses add: klass]]. stream nextPutAll: klass ! visitVariableNode: aNode (self currentClass allInstanceVariableNames includes: aNode value) ifTrue: [stream nextPutAll: 'self[''@', aNode value, ''']'] ifFalse: [ (self knownVariables includes: aNode value) ifFalse: [ unknownVariables add: aNode value]. stream nextPutAll: aNode value] ! visitJSStatementNode: aNode stream nextPutAll: (aNode source replace: '>>' with: '>') ! visitFailure: aFailure self error: aFailure asString ! ! !Compiler class methodsFor: 'compiling'! recompile: aClass aClass methodDictionary do: [:each || method | method := self new load: each source forClass: aClass. method category: each category. aClass addCompiledMethod: method]. aClass isMetaclass ifFalse: [self recompile: aClass class] ! recompileAll Smalltalk current classes do: [:each | self recompile: each] ! ! Object subclass: #DoIt instanceVariableNames: '' category: 'Compiler'! !DoIt methodsFor: ''! doIt ^[StrippedExporter new exportCategory: 'IDE'] value ! !