SystemOrganization addCategory: #'AST-Compiler'! RBProgramNodeVisitor subclass: #RBTranslator instanceVariableNames: 'encoder' classVariableNames: '' poolDictionaries: '' category: 'AST-Compiler'! !RBTranslator class methodsFor: 'instance creation' stamp: 'lr 12/15/2009 11:53'! encoder: anEncoder ^ self new encoder: anEncoder; yourself! ! !RBTranslator methodsFor: 'visiting' stamp: 'lr 12/15/2009 11:03'! acceptArrayNode: anArrayNode ^ BraceNode new elements: (anArrayNode statements collect: [ :each | self visitNode: each ]) sourceLocations: (anArrayNode statements collect: [ :each | each start ])! ! !RBTranslator methodsFor: 'visiting' stamp: 'lr 12/16/2009 20:08'! acceptAssignmentNode: anAssignmentNode | variable value assignment | assignment := AssignmentNode new variable: (self visitNode: anAssignmentNode variable) value: (self visitNode: anAssignmentNode value) from: self encoder sourceRange: anAssignmentNode sourceInterval. assignment variable nowHasDef. ^ assignment! ! !RBTranslator methodsFor: 'visiting' stamp: 'lr 12/17/2009 08:24'! 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: (arguments isEmpty ifTrue: [ ParseNode classPool at: #NodeNil ] ifFalse: [ self encoder encodeVariable: arguments last name ]) ]. block arguments: arguments statements: statements returns: aBlockNode body lastIsReturn from: self encoder; temporaries: temporaries. block noteSourceRangeStart: aBlockNode start end: aBlockNode stop encoder: self encoder. arguments do: [ :variable | variable scope: -1 ]. temporaries do: [ :variable | variable scope: -1 ]. ^ block! ! !RBTranslator methodsFor: 'visiting' stamp: 'lr 12/17/2009 08:35'! acceptCascadeNode: aCascadeNode | recevier | ^ CascadeNode new receiver: (recevier := self visitNode: aCascadeNode receiver) messages: (aCascadeNode messages collect: [ :node | MessageNode new receiver: recevier selector: node selector arguments: (node arguments collect: [ :each | self visitNode: each ]) precedence: node selector precedence from: self encoder sourceRange: node sourceInterval; receiver: nil ])! ! !RBTranslator methodsFor: 'visiting' stamp: 'lr 12/15/2009 15:10'! acceptLiteralArrayNode: aRBLiteralArrayNode ^ self encoder encodeLiteral: aRBLiteralArrayNode value! ! !RBTranslator methodsFor: 'visiting' 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! ! !RBTranslator methodsFor: 'visiting' stamp: 'lr 12/16/2009 10:40'! 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: aMessageNode sourceInterval! ! !RBTranslator methodsFor: 'visiting' stamp: 'lr 12/27/2009 16:36'! 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 := (aMethodNode selector = #DoItIn: and: [ aMethodNode arguments first name = encoder doItInContextName ]) ifTrue: [ Array with: (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. block returnSelfIfNoOther: self encoder. ^ method selector: aMethodNode selector arguments: arguments precedence: aMethodNode selector precedence temporaries: temporaries block: block encoder: self encoder primitive: aMethodNode primitiveNumber properties: properties! ! !RBTranslator methodsFor: 'visiting' stamp: 'lr 12/16/2009 10:36'! acceptPragmaNode: aPragmaNode | pragma name module | pragma := Pragma keyword: aPragmaNode selector arguments: (aPragmaNode arguments collect: [ :each | each value ]) asArray. (aPragmaNode isPrimitive and: [ 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! ! !RBTranslator methodsFor: 'visiting' stamp: 'lr 12/15/2009 12:24'! acceptReturnNode: aReturnNode ^ ReturnNode new expr: (self visitNode: aReturnNode value) encoder: self encoder sourceRange: (aReturnNode start isNil ifFalse: [ aReturnNode sourceInterval ])! ! !RBTranslator methodsFor: 'visiting' stamp: 'lr 12/17/2009 08:24'! acceptSequenceNode: aSequenceNode ^ aSequenceNode statements collect: [ :each | self visitNode: each ]! ! !RBTranslator methodsFor: 'visiting' stamp: 'lr 12/16/2009 10:54'! 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: aVariableNode sourceInterval ifUnknown: [ self error: 'Unknow variable' ]! ! !RBTranslator methodsFor: 'accessing' stamp: 'lr 12/15/2009 11:54'! encoder ^ encoder! ! !RBTranslator methodsFor: 'accessing' stamp: 'lr 12/15/2009 11:53'! encoder: anEncoder encoder := anEncoder! ! Object subclass: #RBCompiler instanceVariableNames: 'source requestor class category context failBlock' classVariableNames: '' poolDictionaries: '' category: 'AST-Compiler'! !RBCompiler methodsFor: 'compiling' stamp: 'lr 12/27/2009 16:39'! compile: aString in: aClass classified: aCategory notifying: aRequestor ifFail: aFailBlock | parseTree encoder translator methodNode | self setSource: aString; setClass: aClass; setCategory: aCategory; setRequestor: aRequestor; setFailBlock: [ ^ aFailBlock value ]. parseTree := self parserClass parseMethod: source onError: [ :msg :pos | ^ self notify: msg at: pos ]. encoder := self encoderClass new. encoder init: class context: context notifying: requestor. translator := RBTranslator encoder: encoder. ^ translator visitNode: parseTree! ! !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 12/15/2009 11:50'! encoderClass ^ 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 12/27/2009 16:12'! 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 translate: (self parse: false). method := node generate: #(0 0 0 0). self interactive ifTrue: [ method := method copyWithTempsFromMethodNode: node ]. 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: 'formatting' stamp: 'lr 12/27/2009 16:00'! format: aString in: aClass notifying: aRequestor "Answer a string containing the original code, formatted nicely." | tree | self setSource: aString; setClass: aClass; setRequestor: aRequestor. tree := self parse: true. ^ tree formattedCode! ! !RBCompiler methodsFor: 'initialization' stamp: 'lr 12/27/2009 15:55'! initialize super initialize. ! ! !RBCompiler methodsFor: 'errors' stamp: 'lr 12/27/2009 15:37'! interactive ^ UIManager default interactiveParserFor: requestor! ! !RBCompiler methodsFor: 'errors' stamp: 'lr 12/27/2009 15:44'! notify: aString "Refer to the comment in Object|notify:." ^ self notify: aString at: 1! ! !RBCompiler methodsFor: 'errors' stamp: 'lr 12/27/2009 15:44'! 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 ]! ! !RBCompiler methodsFor: 'private' stamp: 'lr 12/27/2009 16:03'! parse: aPatternBoolean ^ aPatternBoolean 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: 'configuration' stamp: 'lr 12/15/2009 11:31'! parserClass ^ RBParser! ! !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 12/27/2009 16:28'! translate: aProgramNode | encoder | encoder := self encoderClass new. encoder init: class context: context notifying: requestor. 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)) ] ]. ^ (RBTranslator encoder: encoder) visitNode: aProgramNode methodNode! ! !RBMethodNode methodsFor: '*ast-compiler' stamp: 'lr 12/17/2009 08:21'! compile: aCompilationContext "Compiles the receiving AST in aCompilation context."! ! !RBMethodNode methodsFor: '*ast-compiler' stamp: 'lr 12/17/2009 08:22'! evaluate: anEvaluationContext "Evaluates the receiving AST in anEvaluationContext."! ! !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 ]! ! TestCase subclass: #RBCompilerTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Compiler'! !RBCompilerTest methodsFor: 'utilties' stamp: 'lr 12/16/2009 11:05'! assertClass: aClass aClass selectors asSortedCollection do: [ :each | self assertClass: aClass selector: each ] displayingProgress: aClass name! ! !RBCompilerTest methodsFor: 'utilties' stamp: 'lr 12/27/2009 16:53'! assertClass: aClass selector: aSelector "Assert that aClass >> #aSelector compiles to identical bytecode as currently installed. Skip traits methods and skipt the float class due to bugs in Pharo." | method | (aClass includesLocalSelector: aSelector) ifFalse: [ ^ self ]. (aClass = Float class or: [ aClass traits notEmpty ]) ifTrue: [ ^ self ]. method := self compiler compile: (aClass sourceCodeAt: aSelector) in: aClass notifying: nil ifFail: nil. self assert: (aClass compiledMethodAt: aSelector) = 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: 'testing' stamp: 'lr 12/15/2009 15:22'! testBoolean Boolean withAllSubclasses do: [ :each | self assertClass: each ]! ! !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 12/27/2009 16:48'! testNumber Number withAllSubclasses do: [ :each | self assertClass: each ]! ! !RBCompilerTest methodsFor: 'testing' stamp: 'lr 12/27/2009 16:54'! testObject self assertClass: Object. self assertClass: ProtoObject! !