SystemOrganization addCategory: #'AST-Compiler'!

!RBProgramNode methodsFor: '*ast-compiler-ranges' stamp: 'lr 5/4/2010 08:47'!
range
	^ self rangeStart to: self rangeStop! !

!RBProgramNode methodsFor: '*ast-compiler-ranges' stamp: 'lr 9/20/2010 20:12'!
rangeStart
	^ self propertyAt: #rangeStart ifAbsent: [ self start ifNil: [ 0 ] ]! !

!RBProgramNode methodsFor: '*ast-compiler-ranges' stamp: 'lr 5/4/2010 08:45'!
rangeStart: anInteger
	self propertyAt: #rangeStart put: anInteger! !

!RBProgramNode methodsFor: '*ast-compiler-ranges' stamp: 'lr 9/20/2010 20:12'!
rangeStop
	^ self propertyAt: #rangeStop ifAbsent: [ self stop ifNil: [ -1 ] ]! !

!RBProgramNode methodsFor: '*ast-compiler-ranges' stamp: 'lr 5/4/2010 08:46'!
rangeStop: anInteger
	self propertyAt: #rangeStop put: anInteger! !

RBProgramNodeVisitor subclass: #RBCompilerTranslator
	instanceVariableNames: 'compiler encoder node'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Compiler'!

!RBCompilerTranslator class methodsFor: 'instance creation' stamp: 'lr 1/11/2010 11:14'!
compiler: aCompiler encoder: anEncoder
	^ self new
		compiler: aCompiler;
		encoder: anEncoder;
		yourself! !

!RBCompilerTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 5/4/2010 08:50'!
acceptArrayNode: anArrayNode
	^ BraceNode new
		elements: (anArrayNode statements
			collect: [ :each | self visitNode: each ])
		sourceLocations: (anArrayNode statements
			collect: [ :each | each rangeStart ])! !

!RBCompilerTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 2/18/2010 20:09'!
acceptAssignmentNode: anAssignmentNode
	| variable value assignment |
	assignment := AssignmentNode new
		variable: (self visitNode: anAssignmentNode variable)
		value: (self visitNode: anAssignmentNode value)
		from: self encoder
		sourceRange: (self sourceIntervalFor: anAssignmentNode).
	assignment variable nowHasDef.
	^ assignment! !

!RBCompilerTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 11/24/2010 09:59'!
acceptBlockNode: aBlockNode
	| block arguments temporaries statements |
	block := BlockNode new.
	arguments := aBlockNode arguments
		collect: [ :each | self encoder bindBlockArg: each name within: block ].
	temporaries := aBlockNode body temporaries
		collect: [ :each | self encoder bindBlockTemp: each name within: block ].
	statements := self visitNode: aBlockNode body.
	statements isEmpty 
		ifTrue: [ statements addLast: (ParseNode classPool at: #NodeNil) ].
	block
		arguments: arguments
		statements: statements 
		returns: aBlockNode body lastIsReturn 
		from: self encoder;
		temporaries: temporaries.
	aBlockNode range isEmpty
		ifFalse: [ block noteSourceRangeStart: aBlockNode rangeStart end: aBlockNode rangeStop encoder: self encoder ].
	arguments
		do: [ :variable | variable scope: -1 ].
	temporaries
		do: [ :variable | variable scope: -1 ].
	^ block! !

!RBCompilerTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 9/11/2010 09:35'!
acceptCascadeNode: aCascadeNode
	| recevier |
	^ CascadeNode new 
		receiver: (recevier := self visitNode: aCascadeNode receiver)
		messages: (aCascadeNode messages collect: [ :message |
			MessageNode new
				receiver: recevier
				selector: message selector
				arguments: (message arguments
					collect: [ :each | self visitNode: each ])
				precedence: message selector precedence
				from: self encoder
				sourceRange: (self sourceIntervalFor: message);
				receiver: nil ])! !

!RBCompilerTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/15/2009 15:10'!
acceptLiteralArrayNode: aRBLiteralArrayNode
	^ self encoder encodeLiteral: aRBLiteralArrayNode value! !

!RBCompilerTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/16/2009 10:54'!
acceptLiteralNode: aLiteralNode
	aLiteralNode value == nil
		ifTrue: [ ^ ParseNode classPool at: #NodeNil ].
	aLiteralNode value == true 
		ifTrue: [ ^ ParseNode classPool at: #NodeTrue ].
	aLiteralNode value == false
		ifTrue: [ ^ ParseNode classPool at: #NodeFalse ].
	^ self encoder encodeLiteral: aLiteralNode value! !

!RBCompilerTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 2/18/2010 20:09'!
acceptMessageNode: aMessageNode
	^ MessageNode new
		receiver: (self visitNode: aMessageNode receiver)
		selector: aMessageNode selector
		arguments: (aMessageNode arguments
			collect: [ :each | self visitNode: each ])
		precedence: aMessageNode selector precedence
		from: self encoder
		sourceRange: (self sourceIntervalFor: aMessageNode)! !

!RBCompilerTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/4/2011 16:20'!
acceptMethodNode: aMethodNode
	| method properties arguments temporaries pragmas statements block |
	self encoder selector: aMethodNode selector.
	method := self encoder methodNodeClass new.
	method sourceText: aMethodNode source.
	properties := AdditionalMethodState new.
	properties selector: aMethodNode selector.
	arguments := (self isDoIt: aMethodNode)
		ifTrue: [ Array with: (self encoder encodeVariable: aMethodNode arguments first name) ]
		ifFalse: [ 
			aMethodNode arguments
				collect: [ :each | (self encoder bindArg: each name) beMethodArg ] ].
	temporaries := aMethodNode body temporaries
		collect: [ :each | self encoder bindTemp: each name ].
	aMethodNode pragmas
		do: [ :each | properties := properties copyWith: (self visitNode: each ) ].
	statements := self visitNode: aMethodNode body.
	statements isEmpty
		ifTrue: [ statements addLast: (self encoder encodeVariable: 'self') ].
	block := BlockNode new.
	block
		arguments: Array new
		statements: statements
		returns: aMethodNode lastIsReturn
		from: self encoder.
	(self isDoIt: aMethodNode)
		ifTrue: [ block returnLast ]
		ifFalse: [ block returnSelfIfNoOther: encoder ].
	^ method
		selector: aMethodNode selector
		arguments: arguments
		precedence: aMethodNode selector precedence
		temporaries: temporaries
		block: block
		encoder: self encoder
		primitive: aMethodNode primitiveNumber
		properties: properties! !

!RBCompilerTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/4/2011 16:16'!
acceptPragmaNode: aPragmaNode
	| pragma name module |
	pragma := Pragma
		keyword: aPragmaNode selector
		arguments: (aPragmaNode arguments
			collect: [ :each | each value ]) asArray.
	aPragmaNode isPrimitive ifTrue: [
		pragma arguments first isString ifTrue: [
			name := pragma arguments at: 1.
			module := pragma arguments at: 2 ifAbsent: [ nil ].
     			self encoder litIndex: (Array 
				with: (module ifNotNil: [ module asSymbol ])
				with: name asSymbol
				with: 0 with: 0) ].
		(pragma keyword endsWith: #error:) ifTrue: [
			name := pragma arguments last asString.
			pragma arguments at: pragma arguments size put: name.
			self encoder floatTemp: (self encoder bindTemp: name) nowHasDef ] ].
	^ pragma! !

!RBCompilerTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/4/2011 16:40'!
acceptReturnNode: aReturnNode
	| expression |
	expression := self visitNode: aReturnNode value.
	expression isReturningIf ifTrue: [ ^ expression ].
	^ ReturnNode new 
		expr: (self visitNode: aReturnNode value)
		encoder: self encoder
		sourceRange: (self sourceIntervalFor: aReturnNode)! !

!RBCompilerTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 12/17/2009 08:24'!
acceptSequenceNode: aSequenceNode
	^ aSequenceNode statements collect: [ :each | self visitNode: each ]! !

!RBCompilerTranslator methodsFor: 'visitor-double dispatching' stamp: 'lr 2/18/2010 20:09'!
acceptVariableNode: aVariableNode
	aVariableNode name = 'self'
		ifTrue: [ ^ ParseNode classPool at: #NodeSelf ].
	aVariableNode name = 'super'
		ifTrue: [ ^ ParseNode classPool at: #NodeSuper ].
	aVariableNode name = 'thisContext'
		ifTrue: [ ^ ParseNode classPool at: #NodeThisContext ].
	^ self encoder 
		encodeVariable: aVariableNode name 
		sourceRange: (self sourceIntervalFor: aVariableNode) 
		ifUnknown: [ self correctVariable: aVariableNode ]! !

!RBCompilerTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 13:59'!
canDeclareClassVariable
	^ self encoder classEncoding ~= UndefinedObject! !

!RBCompilerTranslator methodsFor: 'accessing' stamp: 'lr 1/11/2010 11:14'!
compiler
	^ compiler! !

!RBCompilerTranslator methodsFor: 'accessing' stamp: 'lr 1/11/2010 11:14'!
compiler: aCompiler
	compiler := aCompiler! !

!RBCompilerTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 11:29'!
correctVariable: aNode
	| action temp binding selection |
	(self encoder classEncoding instVarNames includes: aNode name) ifTrue: [
		^ InstanceVariableNode new
			name: aNode name
			index: (self encoder classEncoding allInstVarNames indexOf: aNode name) ].
	
	"If we can't ask the user for correction, make it undeclared"
	self compiler interactive
		ifFalse: [ ^ self encoder undeclared: aNode name ].
	
	"First check to see if the requestor knows anything about the variable"	
	temp := aNode name first isLowercase.
	(temp and: [ (binding := self requestor bindingOf: aNode name) notNil ]) 
		ifTrue: [ ^ self encoder global: binding name: aNode name ].
	selection := self requestor selectionInterval.
	self requestor
		selectFrom: aNode start to: aNode stop;
		select.
	
	"Build the menu with alternatives"
	action := UndeclaredVariable 
		signalFor: self
 		name: aNode name
		inRange: aNode sourceInterval.
	action ifNil: [ ^ self compiler fail ].
	self requestor
		deselect;
		selectInvisiblyFrom: selection first to: selection last.
	^ action value! !

!RBCompilerTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 13:59'!
declareClassVar: aString
	| symbol class |
	symbol := aString asSymbol.
	class := self encoder classEncoding theNonMetaClass.
	class addClassVarName: aString.
	^ self encoder global: (class classPool associationAt: symbol) name: symbol! !

!RBCompilerTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 13:58'!
declareGlobal: aString
	| name |
	name := aString asSymbol.
	^ self encoder
		global: (self encoder environment
			at: name put: nil;
			associationAt: name)
		name: name! !

!RBCompilerTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 13:59'!
declareInstVar: aString
	self encoder classEncoding 
		addInstVarName: aString.
	^ InstanceVariableNode new 
		name: aString index: self encoder classEncoding instSize! !

!RBCompilerTranslator methodsFor: 'callbacks' stamp: 'lr 11/29/2010 12:20'!
declareTempAndPaste: aString
	| sequence insertion |
	sequence := node methodNode body.
	sequence rightBar isNil
		ifTrue: [
			self requestor
				correctFrom: sequence start
				to: sequence start - 1
				with: '| ' , aString , ' |' , String cr , String tab ]
		ifFalse: [
			self requestor
				correctFrom: sequence rightBar
				to: sequence rightBar - 1
				with: aString , ' ' ].
	^ self encoder bindAndJuggle: aString! !

!RBCompilerTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 13:58'!
defineClass: aString
	| name category definition |
	name := aString asSymbol.
	category := UIManager default 
		request: 'Enter class category: '
		initialAnswer: self encoder classEncoding theNonMetaClass category.
	category isEmptyOrNil
		ifTrue: [ category := 'Unknown' ].
	definition := 'Object subclass: ' , name printString , '
		instanceVariableNames: '''' 
		classVariableNames: ''''
		poolDictionaries: ''''
		category: ' , category printString.
	Compiler evaluate: definition.
	^ self encoder
		global: (Smalltalk associationAt: name)
		name: name! !

!RBCompilerTranslator methodsFor: 'accessing' stamp: 'lr 12/15/2009 11:54'!
encoder
	^ encoder! !

!RBCompilerTranslator methodsFor: 'accessing' stamp: 'lr 12/15/2009 11:53'!
encoder: anEncoder
	encoder := anEncoder! !

!RBCompilerTranslator methodsFor: 'private' stamp: 'lr 12/4/2011 16:19'!
isDoIt: aMethodNode
	^ aMethodNode selector = #DoItIn: and: [ aMethodNode arguments first name = self encoder doItInContextName ]! !

!RBCompilerTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 11:29'!
possibleVariablesFor: aString
	^ self encoder possibleVariablesFor: aString! !

!RBCompilerTranslator methodsFor: 'accessing-dynamic' stamp: 'lr 1/11/2010 11:25'!
requestor
	^ self compiler requestor! !

!RBCompilerTranslator methodsFor: 'private' stamp: 'lr 5/4/2010 08:52'!
sourceIntervalFor: aNode
	| range |
	^ (range := aNode range) isEmpty
		ifFalse: [ range ]! !

!RBCompilerTranslator methodsFor: 'callbacks' stamp: 'lr 1/11/2010 13:44'!
substituteVariable: aString atInterval: anInterval
	self requestor 
		correctFrom: anInterval first
		to: anInterval last
		with: aString.
	^ self encoder encodeVariable: aString! !

!RBCompilerTranslator methodsFor: 'visiting' stamp: 'lr 1/11/2010 15:28'!
visitNode: aNode
	| previous result |
	previous := node.
	result := super visitNode: (node := aNode).
	node := previous.
	^ result! !

TestCase subclass: #RBCompilerTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Compiler'!

!RBCompilerTest class methodsFor: 'accessing' stamp: 'lr 9/11/2010 09:43'!
packageNamesUnderTest
	^ #('AST-Compiler')! !

!RBCompilerTest methodsFor: 'utilties' stamp: 'lr 12/4/2011 16:08'!
assertClass: aClass
	aClass selectors asSortedCollection
		do: [ :each | self assertClass: aClass selector: each ]
		displayingProgress: aClass name asString.
	aClass isMeta
		ifFalse: [ self assertClass: aClass class ]! !

!RBCompilerTest methodsFor: 'utilties' stamp: 'lr 9/20/2010 17:34'!
assertClass: aClass selector: aSelector
	"Assert that aClass >> #aSelector compiles to identical bytecode as currently installed. Skip trait methods and skip the Float class due to bugs in Pharo."
	
	| source original method |
	(aClass includesLocalSelector: aSelector)
		ifFalse: [ ^ self ].
	(aClass = Float class or: [ aClass traits notEmpty ])
		ifTrue: [ ^ self ].
	source := aClass sourceCodeAt: aSelector.
	original := Compiler new
		compile: source in: aClass notifying: nil ifFail: nil.
	method := self compiler
		compile: source in: aClass notifying: nil ifFail: nil.
	self 
		assert: original generate = method generate
		description: aClass name , '>>#' , aSelector
		resumable: true! !

!RBCompilerTest methodsFor: 'utilties' stamp: 'lr 12/15/2009 15:25'!
assertImage
	"self new assertImage"

	Smalltalk allClasses
		do: [ :class | self assertClass: class ]
		displayingProgress: 'Testing all Image'
	! !

!RBCompilerTest methodsFor: 'accessing' stamp: 'lr 12/27/2009 16:54'!
compiler
	^ self compilerClass new! !

!RBCompilerTest methodsFor: 'accessing' stamp: 'lr 12/15/2009 12:23'!
compilerClass
	^ RBCompiler! !

!RBCompilerTest methodsFor: 'accessing' stamp: 'lr 12/27/2009 16:59'!
mock
	^ self mockClass new! !

!RBCompilerTest methodsFor: 'accessing' stamp: 'lr 12/27/2009 16:59'!
mockClass
	^ RBCompilerMock! !

!RBCompilerTest methodsFor: 'running' stamp: 'lr 2/12/2010 19:39'!
runCase
	SystemChangeNotifier uniqueInstance
		doSilently: [ super runCase ]! !

!RBCompilerTest methodsFor: 'running' stamp: 'lr 12/27/2009 17:00'!
tearDown
	super tearDown.
	self mockClass selectors
		do: [ :each | self mockClass removeSelector: each ]! !

!RBCompilerTest methodsFor: 'testing' stamp: 'lr 12/15/2009 15:22'!
testBoolean
	Boolean withAllSubclasses
		do: [ :each | self assertClass: each ]! !

!RBCompilerTest methodsFor: 'testing' stamp: 'lr 2/12/2010 19:40'!
testCollection
	Collection withAllSubclasses
		do: [ :each | self assertClass: each ]! !

!RBCompilerTest methodsFor: 'testing-compiling' stamp: 'lr 12/27/2009 17:02'!
testCompileAccessors
	self mockClass compile: 'x ^ x'.
	self mockClass compile: 'x: a x := a'.
	self assert: (self mock x: 2; x) = 2! !

!RBCompilerTest methodsFor: 'testing-compiling' stamp: 'lr 12/27/2009 17:05'!
testCompileConstant
	self mockClass compile: 'first ^ 1'.
	self mockClass compile: 'second ^ self first'.
	self mockClass compile: 'third ^ #third'.

	self assert: (self mock first) = 1.
	self assert: (self mock second) = 1.
	self assert: (self mock third) = 'third'
	! !

!RBCompilerTest methodsFor: 'testing-compiling' stamp: 'lr 4/27/2010 10:34'!
testCompileOverlapping
	self mockClass compile: 'first [ :a | ]. [ :a | ]'.
	self mockClass compile: 'second [ :a | ]. [ | a | ]'.
	self mockClass compile: 'third [ | a | ]. [ :a | ]'.
	self mockClass compile: 'fourth [ | a | ]. [ | a | ]'! !

!RBCompilerTest methodsFor: 'testing-fixtures' stamp: 'lr 11/24/2010 09:57'!
testEmptyBlockWithoutArguments
	self mockClass compile: 'a [ ]'.
	self assertClass: self mockClass! !

!RBCompilerTest methodsFor: 'testing-fixtures' stamp: 'lr 11/24/2010 09:57'!
testEmptyBlockWithoutOneArgument
	self mockClass compile: 'a [ :v ]'.
	self assertClass: self mockClass! !

!RBCompilerTest methodsFor: 'testing-fixtures' stamp: 'lr 11/24/2010 09:58'!
testEmptyBlockWithoutTwoArguments
	self mockClass compile: 'a [ :v :w ]'.
	self assertClass: self mockClass! !

!RBCompilerTest methodsFor: 'testing-evaluating' stamp: 'lr 12/27/2009 16:48'!
testEvaluate
	self assert: (self compiler evaluate: '2 + 3' in: nil to: nil) = 5.
	self assert: (self compiler evaluate: '^ 2 + 3' in: nil to: nil) = 5! !

!RBCompilerTest methodsFor: 'testing-evaluating' stamp: 'lr 12/27/2009 16:47'!
testEvaluateContext
	| point |
	point := 2 @ 3.
	self assert: (self compiler evaluate: 'point' in: thisContext to: nil) = point.
	self assert: (self compiler evaluate: 'point x' in: thisContext to: nil) = point x.
	self assert: (self compiler evaluate: 'point y' in: thisContext to: nil) = point y! !

!RBCompilerTest methodsFor: 'testing-evaluating' stamp: 'lr 12/27/2009 16:47'!
testEvaluateReceiver
	| point |
	point := 2 @ 3.
	self assert: (self compiler evaluate: 'self' in: nil to: nil) isNil.
	self assert: (self compiler evaluate: 'self' in: nil to: point) = point.
	self assert: (self compiler evaluate: 'x' in: nil to: point) = point x.
	self assert: (self compiler evaluate: 'self x' in: nil to: point) = point x.
	self assert: (self compiler evaluate: 'y' in: nil to: point) = point y.
	self assert: (self compiler evaluate: 'self y' in: nil to: point) = point y
	! !

!RBCompilerTest methodsFor: 'testing' stamp: 'lr 8/28/2010 10:55'!
testMorph
	self assertClass: Morph! !

!RBCompilerTest methodsFor: 'testing' stamp: 'lr 12/27/2009 16:48'!
testNumber
	Number withAllSubclasses
		do: [ :each | self assertClass: each ]! !

!RBCompilerTest methodsFor: 'testing' stamp: 'lr 2/18/2010 20:10'!
testObject
	self assertClass: Object! !

!Behavior methodsFor: '*ast-compiler-override' stamp: 'lr 8/28/2010 11:10'!
compilerClass
	"Answer the compiler class responsible for compiling the methods of this class. Be extremely careful as this method might be called before everything is properly setup."
	
	| class |
	class := Smalltalk
		at: #RBCompilerDispatcher
		ifAbsent: [ ^ Compiler ].
	(class respondsTo: #current)
		ifFalse: [ ^ Compiler ].
	(class current isNil)
		ifTrue: [ ^ Compiler ].
	^ class! !

!Behavior methodsFor: '*ast-compiler-override' stamp: 'lr 8/28/2010 10:54'!
evaluatorClass
	^ self compilerClass! !

!RBMethodNode methodsFor: '*ast-compiler-accessing' stamp: 'lr 12/17/2009 08:27'!
primitiveNumber
	| primitive |
	primitive := self pragmas
		detect: [ :each | each isPrimitive ] 
		ifNone: [ ^ 0 ].
	^ primitive arguments first value isNumber
		ifTrue: [ primitive arguments first value ]
		ifFalse: [ 117 ]! !

Object subclass: #RBCompiler
	instanceVariableNames: 'source requestor class category context failBlock'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Compiler'!

!RBCompiler class methodsFor: 'actions' stamp: 'lr 8/28/2010 10:46'!
disable
	"Disable the receving compiler."

	RBCompilerDispatcher current: Compiler! !

!RBCompiler class methodsFor: 'actions' stamp: 'lr 8/28/2010 10:30'!
enable
	"Enable the receving compiler."

	RBCompilerDispatcher current: self! !

!RBCompiler methodsFor: 'errors' stamp: 'lr 11/24/2010 09:47'!
addWarning: aString
	Transcript show: aString; cr! !

!RBCompiler methodsFor: 'compiling' stamp: 'lr 11/29/2010 12:18'!
compile: aString in: aClass classified: aCategory notifying: aRequestor ifFail: aFailBlock
	self
		setSource: aString; setClass: aClass; setCategory: aCategory; 
		setRequestor: aRequestor; setFailBlock: [ ^ aFailBlock value ].
	^ self handler: [ self translate: (self parse: true) ]! !

!RBCompiler methodsFor: 'compiling' stamp: 'lr 12/27/2009 16:02'!
compile: aString in: aClass notifying: aRequestor ifFail: aFailBlock 
	^ self compile: aString in: aClass classified: nil notifying: aRequestor ifFail: aFailBlock ! !

!RBCompiler methodsFor: 'configuration' stamp: 'lr 2/14/2010 10:39'!
encoderClass
	"Answer the encoder to build the compiled method."

	^ EncoderForV3PlusClosures! !

!RBCompiler methodsFor: 'evaluating' stamp: 'lr 12/27/2009 15:47'!
evaluate: aString in: aContext to: aReceiver
	^ self evaluate: aString in: aContext to: aReceiver notifying: nil ifFail: [ ^ #failedDoit ]! !

!RBCompiler methodsFor: 'evaluating' stamp: 'lr 12/27/2009 16:06'!
evaluate: aString in: aContext to: aReceiver notifying: aRequestor ifFail: aFailBlock
	^ self evaluate: aString in: aContext to: aReceiver notifying: aRequestor ifFail: aFailBlock logged: false! !

!RBCompiler methodsFor: 'evaluating' stamp: 'lr 11/29/2010 12:17'!
evaluate: aString in: aContext to: aReceiver notifying: aRequestor ifFail: aFailBlock logged: aLogBoolean
	"Compiles the sourceStream into a parse tree, then generates code into a method. This method is then installed in the receiver's class so that it can be invoked. In other words, if receiver is not nil, then the text can refer to instance variables of that receiver (the Inspector uses this). If aContext is not nil, the text can refer to temporaries in that context (the Debugger uses this). If aRequestor is not nil, then it will receive a notify:at: message before the attempt to evaluate is aborted."

	| node method result | 
	self setSource: aString; setContext: aContext; setRequestor: aRequestor; setFailBlock: [ ^ aFailBlock value ].
	self setClass: (aContext isNil ifTrue: [ aReceiver ] ifFalse: [ aContext receiver ]) class.
	node := self handler: [ self translate: (self parse: false) ].
	method := self interactive
		ifTrue: [ node generateWithTempNames ] 
		ifFalse: [ node generate ].
	result := aReceiver
		withArgs: (context isNil
			ifTrue: [ Array new ]
			ifFalse: [ Array with: context ])
		executeMethod: method.
	aLogBoolean
		ifTrue: [ SystemChangeNotifier uniqueInstance evaluated: aString context: aContext ].
	^ result! !

!RBCompiler methodsFor: 'errors' stamp: 'lr 2/19/2010 11:19'!
fail
	^ failBlock value! !

!RBCompiler methodsFor: 'formatting' stamp: 'lr 9/20/2010 16:32'!
format: aString in: aClass notifying: aRequestor
	"Answer a string containing the original code, formatted nicely."
	
	self setSource: aString; setClass: aClass; setRequestor: aRequestor.
	^ (self parse: true) formattedCode! !

!RBCompiler methodsFor: 'private' stamp: 'lr 11/29/2010 12:26'!
handler: aBlock
	^ aBlock
		on: ReparseAfterSourceEditing 
		do: [ :notification | self setSource: requestor text string; handler: aBlock ]! !

!RBCompiler methodsFor: 'errors' stamp: 'lr 4/27/2010 11:25'!
interactive
	^ UIManager default interactiveParserFor: requestor! !

!RBCompiler methodsFor: 'errors' stamp: 'lr 2/19/2010 11:13'!
notify: aString 
	^ self notify: aString at: 1! !

!RBCompiler methodsFor: 'errors' stamp: 'lr 2/19/2010 11:18'!
notify: aString at: anInteger
	requestor isNil
		ifTrue: [			
			SyntaxErrorNotification
				inClass: class
				category: category
				withCode: (source
					copyReplaceFrom: anInteger
					to: anInteger - 1
					with: aString , ' ->')
				doitFlag: false
				errorMessage: aString
				location: anInteger ]
		ifFalse: [
			requestor
				notify: aString , ' ->'
				at: anInteger
				in: source ].
	^ self fail! !

!RBCompiler methodsFor: 'private' stamp: 'lr 2/19/2010 15:56'!
parse: methodBoolean
	^ methodBoolean 
		ifTrue: [
			self parserClass
				parseMethod: source
				onError: [ :msg :pos | self notify: msg at: pos ] ]
		ifFalse: [ 
			self parserClass
				parseExpression: source 
				onError: [ :msg :pos | self notify: msg at: pos ] ]! !

!RBCompiler methodsFor: 'compiling' stamp: 'lr 7/11/2011 11:21'!
parse: aString in: aClass notifying: aRequestor
	^ self compile: aString in: aClass notifying: aRequestor ifFail: [ nil ]! !

!RBCompiler methodsFor: 'configuration' stamp: 'lr 2/14/2010 10:51'!
parserClass
	"Answer the parser used to read the source code."

	^ RBParser! !

!RBCompiler methodsFor: 'accessing' stamp: 'lr 4/27/2010 10:27'!
requestor
	^ requestor ifNil: [ self ]! !

!RBCompiler methodsFor: 'initialization' stamp: 'lr 12/15/2009 11:38'!
setCategory: aSymbol
	category := aSymbol! !

!RBCompiler methodsFor: 'initialization' stamp: 'lr 12/15/2009 11:41'!
setClass: aClass
	class := aClass! !

!RBCompiler methodsFor: 'initialization' stamp: 'lr 12/15/2009 11:41'!
setContext: aContext
	context := aContext! !

!RBCompiler methodsFor: 'initialization' stamp: 'lr 12/15/2009 11:43'!
setFailBlock: aBlock
	failBlock := aBlock! !

!RBCompiler methodsFor: 'initialization' stamp: 'lr 12/15/2009 11:37'!
setRequestor: anObject
	requestor := anObject! !

!RBCompiler methodsFor: 'initialization' stamp: 'lr 12/27/2009 15:43'!
setSource: aStringOrTextOrStream
	aStringOrTextOrStream isString
		ifTrue: [ ^ source := aStringOrTextOrStream ].
	aStringOrTextOrStream isText
		ifTrue: [ ^ self setSource: aStringOrTextOrStream string ].
	aStringOrTextOrStream isStream
		ifTrue: [ ^ self setSource: aStringOrTextOrStream upToEnd ].
	self error: aStringOrTextOrStream printString , ' invalid source'! !

!RBCompiler methodsFor: 'private' stamp: 'lr 4/27/2010 11:25'!
translate: aProgramNode
	| encoder |
	encoder := self encoderClass new.
	encoder init: class context: context notifying: self.
	aProgramNode isMethod ifFalse: [
		aProgramNode methodNode addReturn.
		context isNil
			ifTrue: [
				aProgramNode methodNode
					renameSelector: #DoIt
					andArguments: #() ]
			ifFalse: [
				aProgramNode methodNode
					renameSelector: #DoItIn: 
					andArguments: (Array with: (RBVariableNode named: encoder doItInContextName)) ] ].
	^ (self translatorClass compiler: self encoder: encoder)
		visitNode: aProgramNode methodNode! !

!RBCompiler methodsFor: 'configuration' stamp: 'lr 2/18/2010 17:16'!
translatorClass
	"Answer the transltor class responsible to transform the AST to the host AST."

	^ RBCompilerTranslator! !

Object subclass: #RBCompilerDispatcher
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Compiler'!

RBCompilerDispatcher class
	instanceVariableNames: 'current'!

RBCompilerDispatcher class
	instanceVariableNames: 'current'!

!RBCompilerDispatcher class methodsFor: 'private' stamp: 'lr 2/14/2010 10:50'!
compilerClass
	^ Compiler! !

!RBCompilerDispatcher class methodsFor: 'accessing' stamp: 'lr 2/12/2010 20:10'!
current
	"Answer the current compiler class."

	^ current! !

!RBCompilerDispatcher class methodsFor: 'accessing' stamp: 'lr 2/12/2010 19:53'!
current: aCompilerClass
	"Set the current compiler class."

	current := aCompilerClass! !

!RBCompilerDispatcher class methodsFor: 'private' stamp: 'lr 2/14/2010 10:50'!
decompilerClass
	^ Decompiler! !

!RBCompilerDispatcher class methodsFor: 'evaluating' stamp: 'lr 9/20/2010 17:26'!
evaluate: aString 
	^ self evaluate: aString for: nil logged: false! !

!RBCompilerDispatcher class methodsFor: 'evaluating' stamp: 'lr 9/20/2010 17:26'!
evaluate: aString for: anObject logged: aBoolean 
	^ self evaluate: aString for: anObject notifying: nil logged: aBoolean! !

!RBCompilerDispatcher class methodsFor: 'evaluating' stamp: 'lr 9/11/2010 11:27'!
evaluate: aString for: anObject notifying: aController logged: aBoolean
	^ self new evaluate: aString in: nil to: anObject notifying: aController ifFail: [ ^ nil ] logged: aBoolean! !

!RBCompilerDispatcher class methodsFor: 'evaluating' stamp: 'lr 9/20/2010 17:26'!
evaluate: aString logged: aBoolean 
	^ self evaluate: aString for: nil logged: aBoolean! !

!RBCompilerDispatcher class methodsFor: 'evaluating' stamp: 'lr 9/20/2010 17:26'!
evaluate: aString notifying: aController logged: aBoolean 
	^ self evaluate: aString for: nil notifying: aController logged: aBoolean! !

!RBCompilerDispatcher class methodsFor: 'evaluating' stamp: 'lr 9/20/2010 17:26'!
format: textOrStream in: aClass notifying: aRequestor
	^ self new format: textOrStream in: aClass notifying: aRequestor! !

!RBCompilerDispatcher class methodsFor: 'initialization' stamp: 'lr 8/28/2010 10:47'!
initialize
	RBCompiler enable! !

!RBCompilerDispatcher class methodsFor: 'instance creation' stamp: 'lr 2/12/2010 21:54'!
new
	^ self current new! !

!RBCompilerDispatcher class methodsFor: 'private' stamp: 'lr 2/14/2010 10:50'!
parserClass
	^ Parser! !

!RBCompilerDispatcher class methodsFor: 'settings' stamp: 'lr 8/28/2010 10:44'!
settingsOn: aBuilder
	<systemsettings>

	(aBuilder pickOne: #current)
		target: self;
		label: 'Compiler';
		default: Compiler;
		parent: #refactoring;
		description: 'The Compiler to be used.';
		domainValues: (Compiler withAllSubclasses asArray) , (RBCompiler withAllSubclasses asArray)! !

!RBCompilerDispatcher class methodsFor: 'initialization' stamp: 'lr 12/4/2011 16:45'!
unload
	RBCompiler disable! !

!RBCompilerDispatcher methodsFor: 'accessing' stamp: 'lr 2/12/2010 19:52'!
readme
	"I am a generic class dispatching to to the right compiler instance. I am not supposed to be instantiated, but instead instantiate the responsible compiler."! !

Object subclass: #RBCompilerMock
	instanceVariableNames: 'x t1'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Compiler'!

!RBCompilerMock class methodsFor: 'accessing' stamp: 'lr 12/27/2009 16:57'!
compilerClass
	^ RBCompiler! !
RBCompilerDispatcher initialize!