123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354 |
- 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
- ^self eval: (self compile: aString forClass: aClass)
-
!
compile: aString forClass: aClass
- self currentClass: aClass.
- ^self compile: aString
!
compileExpression: aString
- self currentClass: DoIt.
- ^self compileNode: (self parseExpression: aString)
-
!
eval: aString
- {'return 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 |
- self recompile: each]
! !
!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({', String cr;
- nextPutAll: 'selector: "', aNode selector, '",', String cr.
- Smalltalk current debugMode ifTrue: [
- stream nextPutAll: 'source: unescape("', aNode source escaped, '"),', String cr].
- stream nextPutAll: 'fn: function('.
- aNode arguments
- do: [:each |
- tempVariables add: each.
- stream nextPutAll: each]
- separatedBy: [stream nextPutAll: ', '].
- stream
- nextPutAll: '){', String cr;
- nextPutAll: 'var self=this;', String cr.
- str := stream.
- stream := '' writeStream.
- aNode nodes do: [:each |
- self visit: each].
- earlyReturn ifTrue: [
- str nextPutAll: 'try{'].
- str nextPutAll: stream contents.
- stream := str.
- stream
- nextPutAll: String cr;
- nextPutAll: 'return self;'.
- earlyReturn ifTrue: [
- stream nextPutAll: String cr, '} catch(e) {if(e.name === ''stReturn'' && e.selector === ', currentSelector printString, '){return e.fn()} throw(e)}'].
- stream nextPutAll: '}'.
- Smalltalk current debugMode ifTrue: [
- stream
- nextPutAll: ',', String cr, 'messageSends: ';
- nextPutAll: messageSends asJavascript, ',', String cr;
- 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;'.
- stream nextPutAll: String cr].
- aNode nodes do: [:each |
- self visit: each.
- stream nextPutAll: ';']
- separatedBy: [stream nextPutAll: String cr]
-
!
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;'.
- stream nextPutAll: String cr].
- 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 instanceVariableNames 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 value replace: '''''' with: '''')
! !
!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 ^[ChunkExporter new exportCategory: 'Parser' ] value
! !
|