resin 0.3.1 → 0.4.0

data/amber/st/Compiler-Core.st

@@ -85,12 +85,10 @@ evaluateExpression: aString
 !
 
 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
+   	^ ClassBuilder new
+    	installMethod: (self eval: (self compile: aString forClass: aBehavior))
+        forClass: aBehavior
+        category: anotherString
 !
 
 parse: aString
@@ -105,7 +103,7 @@ recompile: aClass
 	aClass methodDictionary do: [:each |
 		console log: aClass name, ' >> ', each selector.
 		self install: each source forClass: aClass category: each category].
-	self setupClass: aClass.
+	"self setupClass: aClass."
 	aClass isMetaclass ifFalse: [self recompile: aClass class]
 !
 
@@ -113,10 +111,6 @@ recompileAll
 	Smalltalk current classes do: [:each |
 		Transcript show: each; cr.
 		[self recompile: each] valueWithTimeout: 100]
-!
-
-setupClass: aClass
-	<smalltalk.init(aClass)>
 ! !
 
 !Compiler class methodsFor: 'compiling'!
@@ -149,7 +143,7 @@ visit: aNode
 !
 
 visitAll: aCollection
-	^ aCollection do: [ :each | self visit: each ]
+	^ aCollection collect: [ :each | self visit: each ]
 !
 
 visitAssignmentNode: aNode
@@ -294,542 +288,3 @@ translator
 		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
-! !
-