SystemOrganization addCategory: #'AST-Nodes'! SystemOrganization addCategory: #'AST-NodesExt'! SystemOrganization addCategory: #'AST-ParseTree Matching'! SystemOrganization addCategory: #'AST-RBParser'! SystemOrganization addCategory: #'AST-Tests'! SystemOrganization addCategory: #'AST-Tokens'! SystemOrganization addCategory: #'AST-Visitors'! TestCase subclass: #RBAbstractTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBAbstractTest class methodsFor: 'accessing' stamp: 'ms 3/31/2007 20:43'! defaultParser ^Smalltalk at: #SqueakParser ifAbsent: [RBParser]! ! !RBAbstractTest class methodsFor: 'testing' stamp: 'ms 9/16/2006 23:48'! isAbstract ^self = RBAbstractTest! ! !RBAbstractTest methodsFor: 'testing' stamp: 'ms 3/31/2007 16:55'! assertPosition: node start: start stop: stop self assert: node start = start. self assert: node stop = stop! ! !RBAbstractTest methodsFor: 'accessing' stamp: 'ms 9/16/2006 23:43'! defaultParser ^self class defaultParser! ! RBAbstractTest subclass: #RBArrayNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBArrayNodeTest methodsFor: 'method - tested' stamp: 'ms 3/31/2007 20:45'! expectedFailures Smalltalk at: #SqueakParser ifAbsent:[^#(#testFirstLastToken)]. ^#()! ! !RBArrayNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 16:38'! testFirstLastToken "self debug: #testFirstLastToken" | rbNode | rbNode := (self defaultParser parseMethod: 'test {a := b. jo}') body statements first. self assert: (rbNode firstToken value = '{'). self assert: (rbNode lastToken value = '}'). rbNode := (self defaultParser parseMethod: 'test ({a := b. 3. {si}})') body statements first. self assert: (rbNode firstToken value = '('). self assert: (rbNode lastToken value = ')') ! ! !RBArrayNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 16:58'! testPosition "self debug: #testPosition" | rbNode | rbNode := (self defaultParser parseMethod: 'test {a := b. jo}') body statements first. self assertPosition: rbNode start: 6 stop: 17. rbNode := (self defaultParser parseMethod: 'test ({a := b. 3. {si}})') body statements first. self assertPosition: rbNode start: 7 stop: 23. ! ! RBAbstractTest subclass: #RBAssignmentNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBAssignmentNodeTest methodsFor: 'method - tested' stamp: 'ms 3/31/2007 20:46'! expectedFailures Smalltalk at: #SqueakParser ifAbsent:[^#(#testFirstLastToken)]. ^#()! ! !RBAssignmentNodeTest methodsFor: 'testing' stamp: 'ms 9/18/2006 18:37'! testFirstLastToken | rbNode | rbNode := (self defaultParser parseMethod: 'test a := b') body statements first. self assert: (rbNode firstToken value = 'a'). self assert: (rbNode lastToken value = 'b'). rbNode := (self defaultParser parseMethod: 'test (a := b)') body statements first. self assert: (rbNode firstToken value = '('). self assert: (rbNode lastToken value = ')')! ! !RBAssignmentNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 17:37'! testPosition | rbNode | rbNode := (self defaultParser parseMethod: 'test a := b') body statements first. self assertPosition: rbNode start: 6 stop: 11. rbNode := (self defaultParser parseMethod: 'test (a := b)') body statements first. self assertPosition: rbNode start: 6 stop: 13.! ! !RBAssignmentNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 18:47'! testValue | rbNode | rbNode := (self defaultParser parseMethod: 'test a := b') body statements first. self assert: (rbNode value isKindOf: RBVariableNode). rbNode := (self defaultParser parseMethod: 'test (a := b foo)') body statements first. self assert: (rbNode value isKindOf: RBMessageNode)! ! RBAbstractTest subclass: #RBBlockNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBBlockNodeTest methodsFor: 'method - tested' stamp: 'ms 3/31/2007 20:46'! expectedFailures Smalltalk at: #SqueakParser ifAbsent:[^#(#testFirstLastToken)]. ^#()! ! !RBBlockNodeTest methodsFor: 'testing' stamp: 'ms 9/18/2006 18:42'! testFirstLastToken | rbNode | rbNode := (self defaultParser parseMethod: 'test []') body statements first. self assert: (rbNode firstToken value = '['). self assert: (rbNode lastToken value = ']'). rbNode := (self defaultParser parseMethod: 'test [:each :a]') body statements first. self assert: (rbNode firstToken value = '['). self assert: (rbNode lastToken value = ']'). rbNode := (self defaultParser parseMethod: 'test [:each :a | ^self]') body statements first. self assert: (rbNode firstToken value = '['). self assert: (rbNode lastToken value = ']'). rbNode := (self defaultParser parseMethod: 'test [^self]') body statements first. self assert: (rbNode firstToken value = '['). self assert: (rbNode lastToken value = ']'). rbNode := (self defaultParser parseMethod: 'test [| temp |]') body statements first. self assert: (rbNode firstToken value = '['). self assert: (rbNode lastToken value = ']'). rbNode := (self defaultParser parseMethod: 'test [:each || temp | ^self]') body statements first. self assert: (rbNode firstToken value = '['). self assert: (rbNode lastToken value = ']')! ! !RBBlockNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 17:02'! testPosition | rbNode | rbNode := (self defaultParser parseMethod: 'test []') body statements first. self assertPosition: rbNode start: 6 stop: 7. rbNode := (self defaultParser parseMethod: 'test [:each :a]') body statements first. self assertPosition: rbNode start: 6 stop: 15. rbNode := (self defaultParser parseMethod: 'test [:each :a | ^self]') body statements first. self assertPosition: rbNode start: 6 stop: 23. rbNode := (self defaultParser parseMethod: 'test [^self]') body statements first. self assertPosition: rbNode start: 6 stop: 12. rbNode := (self defaultParser parseMethod: 'test [| temp |]') body statements first. self assertPosition: rbNode start: 6 stop: 15. rbNode := (self defaultParser parseMethod: 'test [:each || temp | ^self]') body statements first. self assertPosition: rbNode start: 6 stop: 28.! ! RBAbstractTest subclass: #RBCascadeNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBCascadeNodeTest methodsFor: 'testing' stamp: 'ms 9/17/2006 00:30'! testFirstLastToken | rbNode | rbNode := (self defaultParser parseMethod: 'test i factorial; add: aNum') body statements first. self assert: (rbNode firstToken value = 'i'). self assert: (rbNode lastToken value = 'aNum')! ! !RBCascadeNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 17:04'! testPosition | rbNode | rbNode := (self defaultParser parseMethod: 'test i factorial; add: aNum') body statements first. self assertPosition: rbNode start: 6 stop: 27! ! RBAbstractTest subclass: #RBFormatterTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBFormatterTest methodsFor: 'testing' stamp: 'pmm 10/4/2006 14:01'! assertEqualFormattedAfterVerifyCode: aString | methodNode | self assert: (self class environment hasClassNamed: 'SqueakParser'). methodNode := self parse: aString. self assert: (self class environment hasClassNamed: 'ASTChecker'). methodNode verifyIn: self class. self assert: methodNode formattedCode = aString! ! !RBFormatterTest methodsFor: 'testing' stamp: 'pmm 10/4/2006 14:01'! assertEqualFormattedCode: aString | methodNode | self assert: (self class environment hasClassNamed: 'SqueakParser'). methodNode := self parse: aString. self assert: methodNode formattedCode = aString! ! !RBFormatterTest methodsFor: 'method - tested' stamp: 'ms 3/31/2007 20:48'! expectedFailures Smalltalk at: #SqueakParser ifAbsent:[^#(#testAll #testIsPritivePragma)]. ^#()! ! !RBFormatterTest methodsFor: 'fixtures' stamp: 'ms 3/31/2007 17:05'! parse: aString ^self defaultParser parseMethod: aString! ! !RBFormatterTest methodsFor: 'strings' stamp: 'SR 9/3/2006 10:34'! pragmaAndPrimitiveMethodString ^'pragmaAndPrimitive '! ! !RBFormatterTest methodsFor: 'strings' stamp: 'SR 9/3/2006 10:30'! pragmaMethodString ^'pragma '! ! !RBFormatterTest methodsFor: 'strings' stamp: 'SR 9/3/2006 10:29'! primitiveMethodString ^'primitive '! ! !RBFormatterTest methodsFor: 'testing' stamp: 'pmm 10/4/2006 13:58'! testAll #( pragmaAndPrimitiveMethodString pragmaMethodString primitiveMethodString threePragmaMethodString ) do: [ :stringSelector | #( assertEqualFormattedCode: assertEqualFormattedAfterVerifyCode: ) do: [ :assertionSelector | self perform: assertionSelector with: (self perform: stringSelector) ] ]! ! !RBFormatterTest methodsFor: 'strings' stamp: 'pmm 10/4/2006 14:19'! testIsPritivePragma | method primitive pragma | method := self parse: self pragmaAndPrimitiveMethodString. primitive := method pragmas detect: [ :each | each pragma keyword = #primitive: ]. pragma := method pragmas detect: [ :each | each pragma keyword = #pragma: ]. self assert: primitive isPrimitive. self deny: pragma isPrimitive. ! ! !RBFormatterTest methodsFor: 'strings' stamp: 'SR 9/3/2006 10:39'! threePragmaMethodString ^'threePragmas '! ! RBAbstractTest subclass: #RBLiteralNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBLiteralNodeTest methodsFor: 'method - tested' stamp: 'ms 3/31/2007 20:48'! expectedFailures Smalltalk at: #SqueakParser ifAbsent:[^#(#testFirstLastToken)]. ^#()! ! !RBLiteralNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 17:21'! testFirstLastToken | rbNode | rbNode := (self defaultParser parseMethod: 'test true') body statements first. self assert: (rbNode firstToken value = 'true'). self assert: (rbNode lastToken value = 'true'). rbNode := (self defaultParser parseMethod: 'test false') body statements first. self assert: (rbNode firstToken value = 'false'). self assert: (rbNode lastToken value = 'false'). rbNode := (self defaultParser parseMethod: 'test nil') body statements first. self assert: (rbNode firstToken value = 'nil'). self assert: (rbNode lastToken value = 'nil'). rbNode := (self defaultParser parseMethod: 'test 23') body statements first. self assert: (rbNode firstToken value = '23'). self assert: (rbNode lastToken value = '23'). rbNode := (self defaultParser parseMethod: 'test -23') body statements first. self assert: (rbNode firstToken value = '-23'). self assert: (rbNode lastToken value = '-23'). rbNode := (self defaultParser parseMethod: 'test $f') body statements first. self assert: (rbNode firstToken value = '$f'). self assert: (rbNode lastToken value = '$f'). rbNode := (self defaultParser parseMethod: 'test ''bob''') body statements first. self assert: (rbNode firstToken value = '''bob'''). self assert: (rbNode lastToken value = '''bob'''). rbNode := (self defaultParser parseMethod: 'test #''alice''') body statements first. self assert: (rbNode firstToken value = '#'). self assert: (rbNode lastToken value = '''alice'''). rbNode := (self defaultParser parseMethod: 'test #alice') body statements first. self assert: (rbNode firstToken value = '#'). self assert: (rbNode lastToken value = 'alice'). rbNode := (self defaultParser parseMethod: 'test #+') body statements first. self assert: (rbNode firstToken value = '#'). self assert: (rbNode lastToken value = '+'). rbNode := (self defaultParser parseMethod: 'test #alice:') body statements first. self assert: (rbNode firstToken value = '#'). self assert: (rbNode lastToken value = 'alice:'). rbNode := (self defaultParser parseMethod: 'test #alice:bob:') body statements first. self assert: (rbNode firstToken value = '#'). self assert: (rbNode lastToken value = 'alice:bob:'). rbNode := (self defaultParser parseMethod: 'test #[3 4 0]') body statements first. self assert: (rbNode firstToken value = '#'). self assert: (rbNode lastToken value = ']'). rbNode := (self defaultParser parseMethod: 'test #(alice black hat)') body statements first. self assert: (rbNode firstToken value = '#'). self assert: (rbNode lastToken value = ')'). "rbNode := (self defaultParser parseMethod: 'test #:indexOf:') body statements first. self assert: (rbNode firstToken value = '#'). self assert: (rbNode lastToken value = ':indexOf:')" ! ! !RBLiteralNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 17:38'! testPosition | rbNode | rbNode := (self defaultParser parseMethod: 'test true') body statements first. self assertPosition: rbNode start: 6 stop: 9. rbNode := (self defaultParser parseMethod: 'test false') body statements first. self assertPosition: rbNode start: 6 stop: 10. rbNode := (self defaultParser parseMethod: 'test nil') body statements first. self assertPosition: rbNode start: 6 stop: 8. rbNode := (self defaultParser parseMethod: 'test 23') body statements first. self assertPosition: rbNode start: 6 stop: 7. rbNode := (self defaultParser parseMethod: 'test -23') body statements first. self assertPosition: rbNode start: 6 stop: 8. rbNode := (self defaultParser parseMethod: 'test $f') body statements first. self assertPosition: rbNode start: 6 stop: 7. rbNode := (self defaultParser parseMethod: 'test ''bob''') body statements first. self assertPosition: rbNode start: 6 stop: 10. rbNode := (self defaultParser parseMethod: 'test #''alice''') body statements first. self assertPosition: rbNode start: 6 stop: 13. rbNode := (self defaultParser parseMethod: 'test #alice') body statements first. self assertPosition: rbNode start: 6 stop: 11. rbNode := (self defaultParser parseMethod: 'test #+') body statements first. self assertPosition: rbNode start: 6 stop: 7. rbNode := (self defaultParser parseMethod: 'test #alice:') body statements first. self assertPosition: rbNode start: 6 stop: 12. rbNode := (self defaultParser parseMethod: 'test #alice:bob:') body statements first. self assertPosition: rbNode start: 6 stop: 16. rbNode := (self defaultParser parseMethod: 'test #[3 4 0]') body statements first. self assertPosition: rbNode start: 6 stop: 13. rbNode := (self defaultParser parseMethod: 'test #(alice black hat)') body statements first. self assertPosition: rbNode start: 6 stop: 23. "rbNode := (self defaultParser parseMethod: 'test #:indexOf:') body statements first. self assert: (rbNode firstToken value = '#'). self assert: (rbNode lastToken value = ':indexOf:')" ! ! !RBLiteralNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 18:57'! testValue | rbNode | rbNode := (self defaultParser parseMethod: 'test true') body statements first. self assert: (rbNode value = true). rbNode := (self defaultParser parseMethod: 'test false') body statements first. self assert: (rbNode value = false). rbNode := (self defaultParser parseMethod: 'test thisContext') body statements first. self assert: (rbNode value isKindOf: RBVariableNode). rbNode := (self defaultParser parseMethod: 'test nil') body statements first. self assert: (rbNode value = nil). rbNode := (self defaultParser parseMethod: 'test 23') body statements first. self assert: (rbNode value = 23). rbNode := (self defaultParser parseMethod: 'test -23') body statements first. self assert: (rbNode value = -23). rbNode := (self defaultParser parseMethod: 'test $f') body statements first. self assert: (rbNode value = $f). rbNode := (self defaultParser parseMethod: 'test ''bob''') body statements first. self assert: (rbNode value = 'bob'). rbNode := (self defaultParser parseMethod: 'test #''alice''') body statements first. self assert: (rbNode value = #'alice'). rbNode := (self defaultParser parseMethod: 'test #alice') body statements first. self assert: (rbNode value = #alice). rbNode := (self defaultParser parseMethod: 'test #+') body statements first. self assert: (rbNode value = #+). rbNode := (self defaultParser parseMethod: 'test #alice:') body statements first. self assert: (rbNode value = #alice:). rbNode := (self defaultParser parseMethod: 'test #alice:bob:') body statements first. self assert: (rbNode value = #alice:bob:). rbNode := (self defaultParser parseMethod: 'test #(alice black hat)') body statements first. self assert: (rbNode value = #(alice black hat)). rbNode := (self defaultParser parseMethod: 'test #[3 4 0]') body statements first. self assert: (rbNode value = (ByteArray with: 3 with: 4 with: 0)). "rbNode := (self defaultParser parseMethod: 'test #:indexOf:') body statements first. self assert: (rbNode firstToken value = '#'). self assert: (rbNode lastToken value = ':indexOf:')" ! ! RBAbstractTest subclass: #RBMessageNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBMessageNodeTest methodsFor: 'testing' stamp: 'ms 9/17/2006 00:31'! testFirstLastToken | rbNode | rbNode := (self defaultParser parseMethod: 'test v factorial: w') body statements first. self assert: (rbNode firstToken value = 'v'). self assert: (rbNode lastToken value = 'w'). rbNode := (self defaultParser parseMethod: 'test v factorial') body statements first. self assert: (rbNode firstToken value = 'v'). self assert: (rbNode lastToken value = 'factorial')! ! !RBMessageNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 17:20'! testPosition | rbNode | rbNode := (self defaultParser parseMethod: 'test v factorial: w') body statements first. self assertPosition: rbNode start: 6 stop: 19. rbNode := (self defaultParser parseMethod: 'test v factorial') body statements first. self assertPosition: rbNode start: 6 stop: 16.! ! RBAbstractTest subclass: #RBMethodNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBMethodNodeTest methodsFor: 'testing' stamp: 'ms 9/16/2006 23:46'! testChildren self assert: (self defaultParser parseMethod: 'bar: bob foo: alice ^self') children size = 3! ! !RBMethodNodeTest methodsFor: 'testing' stamp: 'ms 4/1/2007 17:45'! testLastFirstToken | aMethodNode | aMethodNode := self defaultParser parseMethod: 'boo: ask tim whereIsBrian'. self assert: (aMethodNode firstToken value = 'boo:'). self assert: (aMethodNode lastToken value = 'whereIsBrian'). self assert: (aMethodNode lastTokenOfPatternMethod value = 'ask'). aMethodNode := self defaultParser parseMethod: 'i tim whereIsBrian'. self assert: (aMethodNode firstToken value = 'i'). self assert: (aMethodNode lastToken value = 'whereIsBrian'). self assert: (aMethodNode lastTokenOfPatternMethod value = 'i')! ! !RBMethodNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 17:22'! testPosition | aMethodNode | aMethodNode := self defaultParser parseMethod: 'boo: ask tim whereIsBrian'. self assertPosition: aMethodNode start: 1 stop: 25.! ! RBAbstractTest subclass: #RBMethodPatternNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBMethodPatternNodeTest methodsFor: 'testing' stamp: 'ms 9/16/2006 22:41'! tesLastFirstToken | rbMethod | rbMethod := RBPatternMethodNode selectorParts: {RBKeywordToken value: 'bob:' start: 0} arguments: {RBIdentifierToken value: 'arg' start: 0}. self assert: (rbMethod firstToken value = 'bob:'). self assert: (rbMethod lastToken value = 'arg')! ! RBAbstractTest subclass: #RBPragmaNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBPragmaNodeTest methodsFor: 'method - tested' stamp: 'ms 3/31/2007 20:51'! expectedFailures Smalltalk at: #SqueakParser ifAbsent:[^#(#testFirstLastToken #testPosition)]. ^#()! ! !RBPragmaNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 17:28'! testFirstLastToken | aMethodNode | aMethodNode := (self defaultParser parseMethod: 'test ') pragmas first. self assert: (aMethodNode firstToken value = '<'). self assert: (aMethodNode lastToken value = '>'). aMethodNode := (self defaultParser parseMethod: 'test ') pragmas second. self assert: (aMethodNode firstToken value = '<'). self assert: (aMethodNode lastToken value = '>').! ! !RBPragmaNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 17:27'! testPosition | aMethodNode | aMethodNode := (self defaultParser parseMethod: 'test ') pragmas first. self assertPosition: aMethodNode start: 6 stop: 18. aMethodNode := (self defaultParser parseMethod: 'test ') pragmas second. self assertPosition: aMethodNode start: 21 stop: 33.! ! RBAbstractTest subclass: #RBReturnNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBReturnNodeTest methodsFor: 'method - tested' stamp: 'ms 3/31/2007 20:49'! expectedFailures Smalltalk at: #SqueakParser ifAbsent:[^#(#testFirstLastToken)]. ^#()! ! !RBReturnNodeTest methodsFor: 'testing' stamp: 'ms 9/18/2006 18:52'! testFirstLastToken | aMethodNode | aMethodNode := (self defaultParser parseMethod: 'test ^i owe: you') body statements first. self assert: (aMethodNode firstToken value = '^'). self assert: (aMethodNode lastToken value = 'you'). aMethodNode := (self defaultParser parseMethod: 'test ^(i owe: you)') body statements first. self assert: (aMethodNode firstToken value = '^'). self assert: (aMethodNode lastToken value = ')')! ! !RBReturnNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 17:38'! testPosition | aMethodNode | aMethodNode := (self defaultParser parseMethod: 'test ^i owe: you') body statements first. self assertPosition: aMethodNode start: 6 stop: 16. aMethodNode := (self defaultParser parseMethod: 'test ^(i owe: you)') body statements first. self assertPosition: aMethodNode start: 6 stop: 18.! ! RBAbstractTest subclass: #RBSequenceNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBSequenceNodeTest methodsFor: 'method - tested' stamp: 'ms 3/31/2007 20:50'! expectedFailures Smalltalk at: #SqueakParser ifAbsent:[^#(#testFirstLastToken #testPosition)]. ^#()! ! !RBSequenceNodeTest methodsFor: 'testing' stamp: 'ms 9/18/2006 23:09'! testFirstLastToken | rbNode | rbNode := (self defaultParser parseMethod: 'test | a b |') body. self assert: (rbNode firstToken value = '|'). self assert: (rbNode lastToken value = '|'). rbNode := (self defaultParser parseMethod: 'test []. u. []') body. self assert: (rbNode firstToken value = '['). self assert: (rbNode lastToken value = ']'). rbNode := (self defaultParser parseMethod: 'test | | []. {}') body. self assert: (rbNode firstToken value = '|'). self assert: (rbNode lastToken value = '}'). rbNode := (self defaultParser parseMethod: 'test | |') body. self assert: (rbNode firstToken value = '|'). self assert: (rbNode lastToken value = '|'). rbNode := (self defaultParser parseMethod: 'test ||') body. self assert: (rbNode firstToken value = '||'). self assert: (rbNode lastToken value = '||'). rbNode := (self defaultParser parseMethod: 'test || ^self') body. self assert: (rbNode firstToken value = '||'). self assert: (rbNode lastToken value = 'self'). rbNode := (self defaultParser parseMethod: 'test [: each || tmp | ^3]') body statements first body. self assert: (rbNode firstToken value = '||'). self assert: (rbNode lastToken value = '3'). rbNode := (self defaultParser parseMethod: 'test ^self') body. self assert: (rbNode firstToken value = '^'). self assert: (rbNode lastToken value = 'self')! ! !RBSequenceNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 20:37'! testPosition | rbNode | rbNode := (self defaultParser parseMethod: 'test | a b |') body. self assertPosition: rbNode start: 6 stop: 12. rbNode := (self defaultParser parseMethod: 'test []. u. []') body. self assertPosition: rbNode start: 6 stop: 14. rbNode := (self defaultParser parseMethod: 'test | | []. {}') body. self assertPosition: rbNode start: 6 stop: 15. rbNode := (self defaultParser parseMethod: 'test | |') body. self assertPosition: rbNode start: 6 stop: 8. rbNode := (self defaultParser parseMethod: 'test ||') body. self assertPosition: rbNode start: 6 stop: 7. rbNode := (self defaultParser parseMethod: 'test || ^self') body. self assertPosition: rbNode start: 6 stop: 13. rbNode := (self defaultParser parseMethod: 'test [: each || tmp | ^3]') body statements first body. self assertPosition: rbNode start: 14 stop: 24. rbNode := (self defaultParser parseMethod: 'test ^self') body. self assertPosition: rbNode start: 6 stop: 10.! ! RBAbstractTest subclass: #RBVariableNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBVariableNodeTest methodsFor: 'method - tested' stamp: 'ms 3/31/2007 20:51'! expectedFailures Smalltalk at: #SqueakParser ifAbsent:[^#(#testFirstLastToken)]. ^#()! ! !RBVariableNodeTest methodsFor: 'testing' stamp: 'ms 9/18/2006 17:26'! testFirstLastToken | rbNode | rbNode := RBVariableNode named: 'foo'. self assert: (rbNode firstToken value = 'foo'). self assert: (rbNode lastToken value = 'foo'). rbNode := (self defaultParser parseMethod: 'test (foo)') body statements first. self assert: (rbNode firstToken value = '('). self assert: (rbNode lastToken value = ')').! ! !RBVariableNodeTest methodsFor: 'testing' stamp: 'ms 3/31/2007 19:00'! testPosition | rbNode | rbNode := (self defaultParser parseMethod: 'test (foo)') body statements first. self assertPosition: rbNode start: 6 stop: 10! ! TestCase subclass: #RBSmallDictionaryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tests'! !RBSmallDictionaryTest methodsFor: 'tests' stamp: 'md 4/13/2007 11:35'! testAdd | dict | dict := RBSmallDictionary new. dict add: #a -> 1. dict add: #b -> 2. self assert: (dict at: #a) = 1. self assert: (dict at: #b) = 2! ! !RBSmallDictionaryTest methodsFor: 'tests' stamp: 'md 4/13/2007 11:37'! testAddAll | dict1 dict2 | dict1 := RBSmallDictionary new. dict1 at: #a put:1 ; at: #b put: 2. dict2 := RBSmallDictionary new. dict2 at: #a put: 3 ; at: #c put: 4. dict1 addAll: dict2. self assert: (dict1 at: #a) = 3. self assert: (dict1 at: #b) = 2. self assert: (dict1 at: #c) = 4.! ! !RBSmallDictionaryTest methodsFor: 'association-tests' stamp: 'md 4/13/2007 11:37'! testAddAssociation "self run:#testAddAssociation" "self debug:#testAddAssociation" | dict | dict := RBSmallDictionary new. dict at: #a put: 1. dict at: #b put: 2. self assert: (dict at: #a) = 1. self assert: (dict at: #b) = 2. dict at: #a put: 10. dict at: #c put: 2. self assert: (dict at: #a) = 10. self assert: (dict at: #b) = 2. self assert: (dict at: #c) = 2 ! ! !RBSmallDictionaryTest methodsFor: 'association-tests' stamp: 'md 4/13/2007 11:37'! testAssociationsSelect | answer d | d := RBSmallDictionary new. d at: (Array with: #hello with: #world) put: #fooBar. d at: Smalltalk put: #'Smalltalk is the key'. d at: #Smalltalk put: Smalltalk. answer := d associationsSelect: [:assoc | assoc key == #Smalltalk and: [assoc value == Smalltalk]]. self should: [answer isKindOf: RBSmallDictionary]. self should: [answer size == 1]. self should: [(answer at: #Smalltalk) == Smalltalk]. answer := d associationsSelect: [:assoc | assoc key == #NoSuchKey and: [assoc value == #NoSuchValue]]. self should: [answer isKindOf: RBSmallDictionary]. self should: [answer size == 0]! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:42'! testAtError "self run: #testAtError" | dict | dict := RBSmallDictionary new. dict at: #a put: 666. self shouldnt: [ dict at: #a ] raise: Error. self should: [ dict at: #b ] raise: Error. ! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:42'! testAtIfAbsent "self run: #testAtIfAbsent" | dict | dict := RBSmallDictionary new. dict at: #a put: 666. self assert: (dict at: #a ifAbsent: [nil]) = 666. self assert: (dict at: #b ifAbsent: [nil]) isNil. ! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:42'! testAtNil "(self run: #testAtNil)" "nil is a valid key in squeak. In VW nil is not a valid key" "Ansi 1.9 p, 168 5.7.2.5 Message: at: key put: newElement Synopsis Store newElement at key in the receiver. Answer newElement. Definition: If lookup succeeds for key, then newElement replaces the element previously stored at key. Otherwise, the newElement is stored at the new key. In either case, subsequent successful lookups for key will answer newElement. Answer newElement. The result is undefined if the key is nil. This clearly indicates that different smalltalks where doing different assumptions." | dict1 | dict1 := RBSmallDictionary new. self shouldnt: [ dict1 at: nil put: #none] raise: Error. self assert: (dict1 at: nil) = #none. ! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:42'! testAtPut "self run: #testAtPut" "self debug: #testAtPut" | adictionary | adictionary := RBSmallDictionary new. adictionary at: #a put: 3. self assert: (adictionary at: #a) = 3. adictionary at: #a put: 3. adictionary at: #a put: 4. self assert: (adictionary at: #a) = 4. adictionary at: nil put: 666. self assert: (adictionary at: nil) = 666 ! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:42'! testAtPutNil "self run: #testAtPut" "self debug: #testAtPut" | dict | dict := RBSmallDictionary new. dict at: nil put: 1. self assert: (dict at: nil) = 1. dict at: #a put: nil. self assert: (dict at: #a) = nil. dict at: nil put: nil. self assert: (dict at: nil) = nil. ! ! !RBSmallDictionaryTest methodsFor: 'tests' stamp: 'md 4/13/2007 11:37'! testComma | dict1 dict2 dict3 | dict1 := RBSmallDictionary new. dict1 at: #a put:1 ; at: #b put: 2. dict2 := RBSmallDictionary new. dict2 at: #a put: 3 ; at: #c put: 4. dict3 := dict1, dict2. self assert: (dict3 at: #a) = 3. self assert: (dict3 at: #b) = 2. self assert: (dict3 at: #c) = 4.! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:42'! testDictionaryConcatenation "self run: #testDictionaryConcatenation" | dict1 dict2 dict3 | dict1 := RBSmallDictionary new. dict1 at: #a put: 'Nicolas' ; at: #b put: 'Damien'. dict2 := RBSmallDictionary new. dict2 at: #a put: 'Christophe' ; at: #c put: 'Anthony'. dict3 := dict1, dict2. self assert: (dict3 at: #a) = 'Christophe'. self assert: (dict3 at: #b) = 'Damien'. self assert: (dict3 at: #c) = 'Anthony'. ! ! !RBSmallDictionaryTest methodsFor: 'association-tests' stamp: 'md 4/13/2007 11:38'! testIncludesAssociation "self run:#testIncludesAssociation" | dict | dict := RBSmallDictionary new. dict at: #a put: 1. dict at: #b put: 2. self assert: (dict includesAssociation: (#a -> 1)). self assert: (dict includesAssociation: (#b -> 2)). ! ! !RBSmallDictionaryTest methodsFor: 'association-tests' stamp: 'md 4/13/2007 11:38'! testIncludesAssociationNoValue "self run:#testIncludesAssociationNoValue" "self debug:#testIncludesAssociationNoValue" | dict a1 a3 | a1 := Association key: #Italie. a3 := Association key: #France value: 'Paris'. self assert: (a1 key = #Italie). self assert: (a1 value isNil). dict := RBSmallDictionary new. dict add: a1. dict add: a3. self assert: (dict includesKey: #France). self assert: (dict includesKey: #Italie). self assert: (dict at: #Italie) isNil. self assert: (dict at: #France) = 'Paris' ! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:42'! testIncludesKey "self run:#testIncludesKey" "self debug:#testIncludesKey" | dict a1 a2 a3 | a1 := Association key: 'Italie'. a2 := Association new. a3 := Association key: 'France' value: 'Paris'. dict := RBSmallDictionary new. dict add: a1 . dict add: a2. dict add: a3. self assert: (dict includesKey: #France). self assert: (dict includesKey: 'France'). self assert: (dict includesKey: #Italie). self assert: (dict includesKey: nil). self assert: (dict at: 'France' ) = 'Paris'. ! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:42'! testKeys "self run:#testKeys " | a1 a2 dict | a1 := Association key: 'France' value: 'Paris'. a2 := Association key: 'Italie' value: 'Rome'. dict := RBSmallDictionary new. dict add: a1. dict add: a2. self assert: (dict keys size) = 2. self assert: (dict keys includes: #France) ! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:42'! testKeysDo "self run: #testKeysDo" "self debug: #testKeysDo" | dict res | dict := RBSmallDictionary new. dict at: #a put: 33. dict at: #b put: 66. res := OrderedCollection new. dict keysDo: [ :each | res add: each]. self assert: res asSet = #(a b) asSet. ! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:42'! testOccurrencesOf "self run:#testOccurrencesOf" | dict | dict := RBSmallDictionary new. dict at: #a put: 1. dict at: #b put: 2. dict at: #c put: 1. dict at: #d put: 3. dict at: nil put: nil. dict at: #z put: nil. self assert: (dict occurrencesOf: 1 ) = 2. self assert: (dict occurrencesOf: nil ) = 2. ! ! !RBSmallDictionaryTest methodsFor: 'tests' stamp: 'md 4/13/2007 11:37'! testPseudo "(self run: #testPseudo)" "true and false are valid keys" | dict1 | dict1 := RBSmallDictionary new. self shouldnt: [dict1 at: true put: #true] raise: Error. self assert: (dict1 at: true) = #true. self shouldnt: [dict1 at: false put: #false] raise: Error. self assert: (dict1 at: false) = #false.! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:43'! testPseudoVariablesAreValidKeys "(self run: #testPseudoVariablesAreValidKeys)" "true and false are valid keys" | dict1 | dict1 := RBSmallDictionary new. self shouldnt: [dict1 at: true put: #true] raise: Error. self assert: (dict1 at: true) = #true. self shouldnt: [dict1 at: false put: #false] raise: Error. self assert: (dict1 at: false) = #false.! ! !RBSmallDictionaryTest methodsFor: 'smalldictTests' stamp: 'md 4/13/2007 11:55'! testRehash | dictionary | dictionary := RBSmallDictionary new: 100. dictionary add: 1 -> 3; at: 2 put: 4; at: 1 put: 4. self assert: dictionary size = 2. self assert: (dictionary inject: 0 into: [:sum :each | sum + each]) = 8. self assert: (dictionary includesKey: 1). self deny: (dictionary includesKey: 3). dictionary rehash. self assert: dictionary size = 2. self assert: (dictionary inject: 0 into: [:sum :each | sum + each]) = 8. self assert: (dictionary includesKey: 1). self deny: (dictionary includesKey: 3). ! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:43'! testRemoveKey "self run:#testRemoveKey " | dict | dict := RBSmallDictionary new. dict at: #a put: 1. dict at: #b put: 2. self assert: (dict keys size) = 2. dict removeKey: #a. self assert: dict keys size = 1. self should: [dict at: #a] raise: Error. self assert: (dict at: #b) = 2 ! ! !RBSmallDictionaryTest methodsFor: 'smalldictTests' stamp: 'md 4/13/2007 11:29'! testSmallDictionary | dictionary total | dictionary := RBSmallDictionary new: 100. dictionary add: 1 -> 3; at: 2 put: 4; at: 1 put: 4. self assert: dictionary size = 2. self assert: (dictionary inject: 0 into: [:sum :each | sum + each]) = 8. self assert: (dictionary includesKey: 1). self deny: (dictionary includesKey: 3). total := 0. dictionary keysDo: [:each | total := total + each]. self assert: total = 3. dictionary removeKey: 2. dictionary copy associationsDo: [:each | dictionary remove: each]. self assert: dictionary size = 0! ! !RBSmallDictionaryTest methodsFor: 'basic tests' stamp: 'md 4/13/2007 11:43'! testValues "self run:#testValues " | a1 a2 a3 dict | a1 := Association key: 'France' value: 'Paris'. a2 := Association key: 'Italie' value: 'Rome'. dict := RBSmallDictionary new. dict add: a1. dict add: a2. self assert: (dict values size ) = 2. self assert: (dict values includes: 'Paris'). a3 := Association new. dict add: a3. self assert: (dict values size ) = 3. self assert: (dict values includes: nil). ! ! Object subclass: #RBParseTreeRule instanceVariableNames: 'searchTree owner' classVariableNames: '' poolDictionaries: '' category: 'AST-ParseTree Matching'! !RBParseTreeRule commentStamp: 'md 8/9/2005 14:55' prior: 0! RBParseTreeRule is the abstract superclass of all of the parse tree searching rules. A parse tree rule is the first class representation of a particular rule to search for. The owner of a rule is the algorithm that actually executes the search. This arrangement allows multiple searches to be conducted by a single Searcher. Instance Variables: owner The searcher that is actually performing the search. searchTree The parse tree to be searched. ! !RBParseTreeRule class methodsFor: 'instance creation' stamp: ''! methodSearch: aString ^(self new) methodSearchString: aString; yourself! ! !RBParseTreeRule class methodsFor: 'instance creation' stamp: ''! search: aString ^(self new) searchString: aString; yourself! ! !RBParseTreeRule methodsFor: 'matching' stamp: ''! canMatch: aProgramNode ^true! ! !RBParseTreeRule methodsFor: 'private' stamp: ''! context ^owner context! ! !RBParseTreeRule methodsFor: 'matching' stamp: ''! foundMatchFor: aProgramNode ^aProgramNode! ! !RBParseTreeRule methodsFor: 'initialize-release' stamp: ''! methodSearchString: aString searchTree := RBParser parseRewriteMethod: aString! ! !RBParseTreeRule methodsFor: 'initialize-release' stamp: ''! owner: aParseTreeSearcher owner := aParseTreeSearcher! ! !RBParseTreeRule methodsFor: 'matching' stamp: ''! performOn: aProgramNode self context empty. ^((searchTree match: aProgramNode inContext: self context) and: [self canMatch: aProgramNode]) ifTrue: [owner recusivelySearchInContext. self foundMatchFor: aProgramNode] ifFalse: [nil]! ! !RBParseTreeRule methodsFor: 'initialize-release' stamp: ''! searchString: aString searchTree := RBParser parseRewriteExpression: aString! ! !RBParseTreeRule methodsFor: 'accessing' stamp: ''! sentMessages ^searchTree sentMessages! ! RBParseTreeRule subclass: #RBReplaceRule instanceVariableNames: 'verificationBlock' classVariableNames: '' poolDictionaries: '' category: 'AST-ParseTree Matching'! !RBReplaceRule commentStamp: 'md 8/9/2005 14:56' prior: 0! RBReplaceRule is the abstract superclass of all of the transforming rules. The rules change the source code by replacing the node that matches the rule. Subclasses implement different strategies for this replacement. Subclasses must implement the following messages: matching foundMatchFor: Instance Variables: verificationBlock Is evaluated with the matching node. This allows for further verification of a match beyond simple tree matching. ! RBReplaceRule subclass: #RBBlockReplaceRule instanceVariableNames: 'replaceBlock' classVariableNames: '' poolDictionaries: '' category: 'AST-ParseTree Matching'! !RBBlockReplaceRule commentStamp: 'md 8/9/2005 14:55' prior: 0! RBBlockReplaceRule replaces the matching node by the result of evaluating replaceBlock. This allows arbitrary computation to come up with a replacement. Instance Variables: replaceBlock The block that returns the node to replace to matching node with. ! !RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''! searchFor: searchString replaceWith: replaceBlock ^self new searchFor: searchString replaceWith: replaceBlock! ! !RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''! searchFor: searchString replaceWith: replaceBlock when: aBlock ^self new searchFor: searchString replaceWith: replaceBlock when: aBlock! ! !RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''! searchForMethod: searchString replaceWith: replaceBlock ^self new searchForMethod: searchString replaceWith: replaceBlock! ! !RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''! searchForMethod: searchString replaceWith: replaceBlock when: aBlock ^self new searchForMethod: searchString replaceWith: replaceBlock when: aBlock! ! !RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''! searchForTree: searchString replaceWith: replaceBlock ^self new searchForTree: searchString replaceWith: replaceBlock! ! !RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''! searchForTree: searchString replaceWith: replaceBlock when: aBlock ^self new searchFor: searchString replaceWith: replaceBlock when: aBlock! ! !RBBlockReplaceRule methodsFor: 'matching' stamp: ''! foundMatchFor: aProgramNode ^replaceBlock value: aProgramNode! ! !RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''! initialize super initialize. replaceBlock := [:aNode | aNode]! ! !RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''! searchFor: searchString replaceWith: aBlock self searchString: searchString. replaceBlock := aBlock! ! !RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''! searchFor: searchString replaceWith: replBlock when: verifyBlock self searchFor: searchString replaceWith: replBlock. verificationBlock := verifyBlock! ! !RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''! searchForMethod: searchString replaceWith: aBlock self methodSearchString: searchString. replaceBlock := aBlock! ! !RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''! searchForMethod: searchString replaceWith: replBlock when: verifyBlock self searchForMethod: searchString replaceWith: replBlock. verificationBlock := verifyBlock! ! !RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''! searchForTree: aBRProgramNode replaceWith: aBlock searchTree := aBRProgramNode. replaceBlock := aBlock! ! !RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''! searchForTree: aBRProgramNode replaceWith: replBlock when: verifyBlock self searchForTree: aBRProgramNode replaceWith: replBlock. verificationBlock := verifyBlock! ! !RBReplaceRule methodsFor: 'matching' stamp: ''! canMatch: aProgramNode ^verificationBlock value: aProgramNode! ! !RBReplaceRule methodsFor: 'matching' stamp: ''! foundMatchFor: aProgramNode self subclassResponsibility! ! !RBReplaceRule methodsFor: 'initialize-release' stamp: ''! initialize super initialize. verificationBlock := [:aNode | true]! ! RBReplaceRule subclass: #RBStringReplaceRule instanceVariableNames: 'replaceTree' classVariableNames: '' poolDictionaries: '' category: 'AST-ParseTree Matching'! !RBStringReplaceRule commentStamp: 'md 8/9/2005 14:56' prior: 0! RBStringReplaceRule replaces a matched tree with another tree (which may include metavariable from the matching tree). This is a very succint syntax for specifying most rewrites. Instance Variables: replaceTree The tree to replace the matched tree with. ! !RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''! searchFor: searchString replaceWith: replaceString ^self new searchFor: searchString replaceWith: replaceString! ! !RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''! searchFor: searchString replaceWith: replaceString when: aBlock ^self new searchFor: searchString replaceWith: replaceString when: aBlock! ! !RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''! searchForMethod: searchString replaceWith: replaceString ^self new searchForMethod: searchString replaceWith: replaceString! ! !RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''! searchForMethod: searchString replaceWith: replaceString when: aBlock ^self new searchForMethod: searchString replaceWith: replaceString when: aBlock! ! !RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''! searchForTree: searchString replaceWith: replaceString ^self new searchForTree: searchString replaceWith: replaceString! ! !RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''! searchForTree: searchString replaceWith: replaceString when: aBlock ^self new searchForTree: searchString replaceWith: replaceString when: aBlock! ! !RBStringReplaceRule methodsFor: 'matching' stamp: ''! foundMatchFor: aProgramNode | newTree | newTree := replaceTree copyInContext: self context. newTree copyCommentsFrom: aProgramNode. ^newTree! ! !RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''! methodReplaceString: replaceString replaceTree := RBParser parseRewriteMethod: replaceString! ! !RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''! replaceString: replaceString replaceTree := RBParser parseRewriteExpression: replaceString. searchTree isSequence = replaceTree isSequence ifFalse: [searchTree isSequence ifTrue: [replaceTree := RBSequenceNode statements: (Array with: replaceTree)] ifFalse: [searchTree := RBSequenceNode statements: (Array with: searchTree)]]! ! !RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''! searchFor: searchString replaceWith: replaceString self searchString: searchString. self replaceString: replaceString! ! !RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''! searchFor: searchString replaceWith: replaceString when: aBlock self searchFor: searchString replaceWith: replaceString. verificationBlock := aBlock! ! !RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''! searchForMethod: searchString replaceWith: replaceString self methodSearchString: searchString. self methodReplaceString: replaceString! ! !RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''! searchForMethod: searchString replaceWith: replaceString when: aBlock self searchForMethod: searchString replaceWith: replaceString. verificationBlock := aBlock! ! !RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''! searchForTree: aBRProgramNode replaceWith: replaceNode searchTree := aBRProgramNode. replaceTree := replaceNode! ! !RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''! searchForTree: aBRProgramNode replaceWith: replaceString when: aBlock self searchForTree: aBRProgramNode replaceWith: replaceString. verificationBlock := aBlock! ! RBParseTreeRule subclass: #RBSearchRule instanceVariableNames: 'answerBlock' classVariableNames: '' poolDictionaries: '' category: 'AST-ParseTree Matching'! !RBSearchRule commentStamp: 'md 8/9/2005 14:56' prior: 0! RBSearchRule is a parse tree rule that simply searches for matches to the rule. Every time a match is found, answerBlock is evaluated with the node that matches and the cureent answer. This two-argument approach allows a collection to be formed from all of the matches (Think inject:into:). Instance Variables: answerBlock Block to evaluate with the matching node and the current answer. ! !RBSearchRule class methodsFor: 'instance creation' stamp: ''! searchFor: aString thenDo: aBlock ^self new searchFor: aString thenDo: aBlock! ! !RBSearchRule class methodsFor: 'instance creation' stamp: ''! searchForMethod: aString thenDo: aBlock ^self new searchForMethod: aString thenDo: aBlock! ! !RBSearchRule class methodsFor: 'instance creation' stamp: ''! searchForTree: aBRProgramNode thenDo: aBlock ^self new searchForTree: aBRProgramNode thenDo: aBlock! ! !RBSearchRule methodsFor: 'testing' stamp: 'bh 4/29/2000 18:15'! canMatch: aProgramNode self needsWork. "testing #copy to attempt to fix block closure issue" owner answer: (answerBlock copy value: aProgramNode value: owner answer). ^ true! ! !RBSearchRule methodsFor: 'initialize-release' stamp: ''! searchFor: aString thenDo: aBlock self searchString: aString. answerBlock := aBlock! ! !RBSearchRule methodsFor: 'initialize-release' stamp: ''! searchForMethod: aString thenDo: aBlock self methodSearchString: aString. answerBlock := aBlock! ! !RBSearchRule methodsFor: 'initialize-release' stamp: ''! searchForTree: aBRProgramNode thenDo: aBlock searchTree := aBRProgramNode. answerBlock := aBlock! ! Object subclass: #RBParser instanceVariableNames: 'scanner currentToken nextToken emptyStatements negatedNumbers errorBlock tags source' classVariableNames: 'BRAraryNode' poolDictionaries: '' category: 'AST-RBParser'! !RBParser commentStamp: 'md 8/9/2005 14:54' prior: 0! RBParser takes a source code string and generates an AST for it. This is a hand-written, recursive descent parser and has been optimized for speed. The simplest way to call this is either 'RBParser parseExpression: aString' if you want the AST for an expression, or 'RBParser parseMethod: aString' if you want to parse an entire method. Instance Variables: currentToken The current token being processed. emptyStatements True if empty statements are allowed. In IBM, they are, in VW they aren't. errorBlock The block to evaluate on a syntax error. nextToken The next token that will be processed. This allows one-token lookahead. scanner The scanner that generates a stream of tokens to parse. source The source code to parse tags The source intervals of the tags appearing at the top of a method (e.g. Primitive calls) Shared Variables: ParserType the type code we are parsing! !RBParser class methodsFor: 'accessing' stamp: 'md 7/17/2006 10:39'! format: textOrStream in: aClass notifying: aRequestor contentsSymbol: aSymbol "Compile a parse tree from the argument, textOrStream. Answer a string containing the original code, formatted nicely. If aBoolean is true, then decorate the resulting text with color and hypertext actions" ^self format: textOrStream asString in: aClass notifying: aRequestor decorated: (aSymbol == #colorPrint)! ! !RBParser class methodsFor: 'accessing' stamp: 'nk 2/23/2005 18:28'! format: aString in: anIgnoredClass notifying: aRequester decorated: decorated | parser squeakString node errorBlock | squeakString := aString asString withBlanksTrimmed. squeakString isEmpty ifTrue: [ ^squeakString ]. errorBlock := [:message :position | self error: ('{1} at position {2}' format: { message. position}) ]. parser := self new. parser errorBlock: errorBlock. parser initializeParserWith: squeakString type: #on:errorBlock:. node := parser parseMethod: squeakString. ^decorated ifTrue: [node colorizedFormattedCode] ifFalse: [node formattedCode]! ! !RBParser class methodsFor: 'accessing' stamp: ''! parseExpression: aString ^self parseExpression: aString onError: nil! ! !RBParser class methodsFor: 'accessing' stamp: 'dvf 11/8/2003 15:02'! parseExpression: aString onError: aBlock | node parser | parser := self new. parser errorBlock: aBlock. parser initializeParserWith: aString type: #on:errorBlock:. node := parser parseExpression. ^(node statements size == 1 and: [node temporaries isEmpty]) ifTrue: [node statements first] ifFalse: [node]! ! !RBParser class methodsFor: 'accessing' stamp: ''! parseMethod: aString ^self parseMethod: aString onError: nil! ! !RBParser class methodsFor: 'accessing' stamp: 'dvf 11/8/2003 04:44'! parseMethod: aString onError: aBlock | parser squeakString | squeakString := aString . parser := self new. parser errorBlock: aBlock. parser initializeParserWith: squeakString type: #on:errorBlock:. ^parser parseMethod: squeakString! ! !RBParser class methodsFor: 'parsing' stamp: ''! parseMethodPattern: aString | parser | parser := self new. parser errorBlock: [:error :position | ^nil]. parser initializeParserWith: aString type: #on:errorBlock:. ^parser parseMessagePattern selector! ! !RBParser class methodsFor: 'accessing' stamp: 'bh 3/7/2000 01:35'! parseMethodWithNoComments: aString ^ self parseMethodWithNoComments: aString onError: nil! ! !RBParser class methodsFor: 'accessing' stamp: 'bh 3/7/2000 01:34'! parseMethodWithNoComments: aString onError: aBlock | parser | parser := self new. parser errorBlock: aBlock. parser initializeParserWith: aString type: #on:errorBlock:. ^ parser parseMethodWithNoComments: aString! ! !RBParser class methodsFor: 'accessing' stamp: ''! parseRewriteExpression: aString ^self parseRewriteExpression: aString onError: nil! ! !RBParser class methodsFor: 'accessing' stamp: ''! parseRewriteExpression: aString onError: aBlock | node parser | parser := self new. parser errorBlock: aBlock. parser initializeParserWith: aString type: #rewriteOn:errorBlock:. node := parser parseExpression. ^(node statements size == 1 and: [node temporaries isEmpty]) ifTrue: [node statements first] ifFalse: [node]! ! !RBParser class methodsFor: 'accessing' stamp: ''! parseRewriteMethod: aString ^self parseRewriteMethod: aString onError: nil! ! !RBParser class methodsFor: 'accessing' stamp: ''! parseRewriteMethod: aString onError: aBlock | parser | parser := self new. parser errorBlock: aBlock. parser initializeParserWith: aString type: #rewriteOn:errorBlock:. ^parser parseMethod: aString! ! !RBParser methodsFor: 'private' stamp: 'tween 6/29/2006 18:42'! addCommentsTo: aNode | existingComments newComments allComments | existingComments := aNode comments ifNil:[OrderedCollection new]. newComments := scanner getComments ifNil:[OrderedCollection new]. allComments := existingComments, newComments. allComments isEmpty ifTrue:[allComments := nil]. aNode comments: allComments! ! !RBParser methodsFor: 'testing' stamp: ''! atEnd ^currentToken class == RBToken! ! !RBParser methodsFor: 'error handling' stamp: ''! errorBlock ^errorBlock isNil ifTrue: [[:message :position | ]] ifFalse: [errorBlock]! ! !RBParser methodsFor: 'accessing' stamp: ''! errorBlock: aBlock errorBlock := aBlock. scanner notNil ifTrue: [scanner errorBlock: aBlock]! ! !RBParser methodsFor: 'error handling' stamp: ''! errorPosition ^currentToken start! ! !RBParser methodsFor: 'initialize-release' stamp: 'ls 1/30/2000 17:55'! initializeForSqueak emptyStatements := true. negatedNumbers := true. scanner notNil ifTrue: [scanner initializeForSqueak]! ! !RBParser methodsFor: 'accessing' stamp: ''! initializeParserWith: aString type: aSymbol source := aString. self scanner: (RBScanner perform: aSymbol with: (ReadStream on: aString) with: self errorBlock)! ! !RBParser methodsFor: 'private' stamp: ''! nextToken ^nextToken isNil ifTrue: [nextToken := scanner next] ifFalse: [nextToken]! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseArgs | args | args := OrderedCollection new. [currentToken isIdentifier] whileTrue: [args add: self parseVariableNode]. ^args! ! !RBParser methodsFor: 'private-parsing' stamp: 'ls 1/24/2000 00:11'! parseArray "parse Squeak's {} construct" | leftBrace node rightBrace | leftBrace := currentToken start. self step. node := RBArrayNode new. self parseStatementList: false into: node. (currentToken isSpecial and: [currentToken value == $}]) ifFalse: [ self parserError: 'expected }' ]. rightBrace := currentToken start. self step. node leftBrace: leftBrace. node rightBrace: rightBrace. ^node! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseAssignment "Need one token lookahead to see if we have a ':='. This method could make it possible to assign the literals true, false and nil." | node position | (currentToken isIdentifier and: [self nextToken isAssignment]) ifFalse: [^self parseCascadeMessage]. node := self parseVariableNode. position := currentToken start. self step. ^RBAssignmentNode variable: node value: self parseAssignment position: position! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseBinaryMessage | node | node := self parseUnaryMessage. [currentToken isLiteral ifTrue: [self patchNegativeLiteral]. currentToken isBinary] whileTrue: [node := self parseBinaryMessageWith: node]. ^node! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseBinaryMessageWith: aNode | binaryToken | binaryToken := currentToken. self step. ^RBMessageNode receiver: aNode selectorParts: (Array with: binaryToken) arguments: (Array with: self parseUnaryMessage)! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseBinaryPattern | binaryToken | currentToken isBinary ifFalse: [self parserError: 'Message pattern expected']. binaryToken := currentToken. self step. ^RBMethodNode selectorParts: (Array with: binaryToken) arguments: (Array with: self parseVariableNode)! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseBlock | position node | position := currentToken start. self step. node := self parseBlockArgsInto: RBBlockNode new. node left: position. node body: (self parseStatements: false). (currentToken isSpecial and: [currentToken value == $]]) ifFalse: [self parserError: ''']'' expected']. node right: currentToken start. self step. ^node! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseBlockArgsInto: node | verticalBar args colons | args := OrderedCollection new: 2. colons := OrderedCollection new: 2. verticalBar := false. [currentToken isSpecial and: [currentToken value == $:]] whileTrue: [colons add: currentToken start. self step. ":" verticalBar := true. args add: self parseVariableNode]. verticalBar ifTrue: [currentToken isBinary ifTrue: [node bar: currentToken start. currentToken value == #| ifTrue: [self step] ifFalse: [currentToken value == #'||' ifTrue: ["Hack the current token to be the start of temps bar" currentToken value: #|; start: currentToken start + 1] ifFalse: [self parserError: '''|'' expected']]] ifFalse: [(currentToken isSpecial and: [currentToken value == $]]) ifFalse: [self parserError: '''|'' expected']]]. node arguments: args; colons: colons. ^node! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseCascadeMessage | node receiver messages semicolons | node := self parseKeywordMessage. (currentToken isSpecial and: [currentToken value == $; and: [node isMessage]]) ifFalse: [^node]. receiver := node receiver. messages := OrderedCollection new: 3. semicolons := OrderedCollection new: 3. messages add: node. [currentToken isSpecial and: [currentToken value == $;]] whileTrue: [semicolons add: currentToken start. self step. messages add: (currentToken isIdentifier ifTrue: [self parseUnaryMessageWith: receiver] ifFalse: [currentToken isKeyword ifTrue: [self parseKeywordMessageWith: receiver] ifFalse: [| temp | currentToken isLiteral ifTrue: [self patchNegativeLiteral]. currentToken isBinary ifFalse: [self parserError: 'Message expected']. temp := self parseBinaryMessageWith: receiver. temp == receiver ifTrue: [self parserError: 'Message expected']. temp]])]. ^RBCascadeNode messages: messages semicolons: semicolons! ! !RBParser methodsFor: 'accessing' stamp: ''! parseExpression | node | node := self parseStatements: false. self atEnd ifFalse: [self parserError: 'Unknown input at end']. ^node! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseKeywordMessage ^self parseKeywordMessageWith: self parseBinaryMessage! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseKeywordMessageWith: node | args isKeyword keywords | args := OrderedCollection new: 3. keywords := OrderedCollection new: 3. isKeyword := false. [currentToken isKeyword] whileTrue: [keywords add: currentToken. self step. args add: self parseBinaryMessage. isKeyword := true]. ^isKeyword ifTrue: [RBMessageNode receiver: node selectorParts: keywords arguments: args] ifFalse: [node]! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseKeywordPattern | keywords args | keywords := OrderedCollection new: 2. args := OrderedCollection new: 2. [currentToken isKeyword] whileTrue: [keywords add: currentToken. self step. args add: self parseVariableNode]. ^RBMethodNode selectorParts: keywords arguments: args! ! !RBParser methodsFor: 'private-parsing' stamp: 'ms 9/16/2006 20:43'! parseMessagePattern ^currentToken isIdentifier ifTrue: [self parseUnaryPattern] ifFalse: [currentToken isKeyword ifTrue: [self parseKeywordPattern] ifFalse: [self parseBinaryPattern]]! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseMethod | methodNode | methodNode := self parseMessagePattern. self parseResourceTag. self addCommentsTo: methodNode. methodNode body: (self parseStatements: true). methodNode tags: tags. ^methodNode! ! !RBParser methodsFor: 'accessing' stamp: ''! parseMethod: aString | node | node := self parseMethod. self atEnd ifFalse: [self parserError: 'Unknown input at end']. node source: aString. ^node! ! !RBParser methodsFor: 'private-parsing' stamp: 'bh 3/7/2000 01:36'! parseMethodWithNoComments | methodNode | methodNode := self parseMessagePattern. self parseResourceTag. "self addCommentsTo: methodNode." methodNode body: (self parseStatements: true). methodNode tags: tags. ^ methodNode! ! !RBParser methodsFor: 'accessing' stamp: 'bh 3/7/2000 01:40'! parseMethodWithNoComments: aString | node | node := self parseMethodWithNoComments. self atEnd ifFalse: [self parserError: 'Unknown input at end']. node source: aString. ^ node! ! !RBParser methodsFor: 'private-parsing' stamp: 'ls 1/30/2000 18:16'! parseNegatedNumber | token | (self nextToken isLiteral not or: [ self nextToken realValue isNumber not ]) ifTrue: [ self parserError: 'only numbers may be negated' ]. "create a new token out of the $- and the number" token := RBLiteralToken value: (self nextToken realValue negated) start: currentToken start stop: nextToken stop. self step. self step. ^RBLiteralNode literalToken: token! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseParenthesizedExpression | leftParen node | leftParen := currentToken start. self step. node := self parseAssignment. ^(currentToken isSpecial and: [currentToken value == $)]) ifTrue: [node addParenthesis: (leftParen to: currentToken start). self step. node] ifFalse: [self parserError: ''')'' expected']! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parsePatternBlock | position node | position := currentToken start. self step. node := self parseBlockArgsInto: RBPatternBlockNode new. node left: position. node body: (self parseStatements: false). (currentToken isSpecial and: [currentToken value == $}]) ifFalse: [self parserError: '''}'' expected']. node right: currentToken start. self step. ^node! ! !RBParser methodsFor: 'private-parsing' stamp: 'tween 6/29/2006 18:15'! parsePrimitiveIdentifier | token answer | token := currentToken. self step. answer := RBVariableNode identifierToken: token. self addCommentsTo: answer. ^answer! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parsePrimitiveLiteral | token | token := currentToken. self step. ^RBLiteralNode literalToken: token! ! !RBParser methodsFor: 'private-parsing' stamp: 'pmm 9/24/2005 10:49'! parsePrimitiveObject currentToken isIdentifier ifTrue: [^self parsePrimitiveIdentifier]. currentToken isLiteral ifTrue: [^self parsePrimitiveLiteral]. currentToken isSpecial ifTrue: [currentToken value == $[ ifTrue: [^self parseBlock]. currentToken value == $( ifTrue: [^self parseParenthesizedExpression]. currentToken value == ${ ifTrue: [^self parseArray]]. (negatedNumbers and: [ currentToken isBinary and: [ currentToken value == #- ] ]) ifTrue: [ ^self parseNegatedNumber ]. currentToken isPatternBlock ifTrue:[^self parsePatternBlock]. self parserError: 'Variable expected'! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseResourceTag | start | [currentToken isBinary and: [currentToken value == #<]] whileTrue: [start := currentToken start. self step. [scanner atEnd or: [currentToken isBinary and: [currentToken value == #>]]] whileFalse: [self step]. (currentToken isBinary and: [currentToken value == #>]) ifFalse: [self parserError: '''>'' expected']. tags isNil ifTrue: [tags := OrderedCollection with: (start to: currentToken stop)] ifFalse: [tags add: (start to: currentToken stop)]. self step]! ! !RBParser methodsFor: 'private-parsing' stamp: 'tween 6/29/2006 18:30'! parseStatementList: tagBoolean into: sequenceNode | statements return periods returnPosition node | return := false. statements := OrderedCollection new. periods := OrderedCollection new. self addCommentsTo: sequenceNode. tagBoolean ifTrue: [self parseResourceTag]. ["skip empty statements" emptyStatements ifTrue: [[currentToken isSpecial and: [currentToken value == $.]] whileTrue: [periods add: currentToken start. self step]]. "check if we are finished yet" self atEnd or: [currentToken isSpecial and: ['])}' includes: currentToken value]]] whileFalse: [return ifTrue: [self parserError: 'End of statement list encounted']. (currentToken isSpecial and: [currentToken value == $^]) ifTrue: [returnPosition := currentToken start. self step. node := RBReturnNode return: returnPosition value: self parseAssignment. self addCommentsTo: node. statements add: node. return := true] ifFalse: [node := self parseAssignment. self addCommentsTo: node. statements add: node]. (currentToken isSpecial and: [currentToken value == $.]) ifTrue: [periods add: currentToken start. self step] ifFalse: [return := true]. ]. statements notEmpty ifTrue: [self addCommentsTo: statements last]. sequenceNode statements: statements; periods: periods. ^sequenceNode! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseStatements: tagBoolean | args leftBar rightBar | args := #(). leftBar := rightBar := nil. currentToken isBinary ifTrue: [currentToken value == #| ifTrue: [leftBar := currentToken start. self step. args := self parseArgs. (currentToken isBinary and: [currentToken value = #|]) ifFalse: [self parserError: '''|'' expected']. rightBar := currentToken start. self step] ifFalse: [currentToken value == #'||' ifTrue: [rightBar := (leftBar := currentToken start) + 1. self step]]]. ^self parseStatementList: tagBoolean into: (RBSequenceNode leftBar: leftBar temporaries: args rightBar: rightBar)! ! !RBParser methodsFor: 'private-parsing' stamp: 'tween 6/29/2006 18:30'! parseUnaryMessage | node | node := self parsePrimitiveObject. self addCommentsTo: node. [currentToken isLiteral ifTrue: [self patchLiteralMessage]. currentToken isIdentifier] whileTrue: [node := self parseUnaryMessageWith: node]. self addCommentsTo: node. ^node! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseUnaryMessageWith: aNode | selector | selector := currentToken. self step. ^RBMessageNode receiver: aNode selectorParts: (Array with: selector) arguments: #()! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseUnaryPattern | selector | selector := currentToken. self step. ^RBMethodNode selectorParts: (Array with: selector) arguments: #()! ! !RBParser methodsFor: 'private-parsing' stamp: ''! parseVariableNode currentToken isIdentifier ifFalse: [self parserError: 'Variable name expected']. ^self parsePrimitiveIdentifier! ! !RBParser methodsFor: 'error handling' stamp: ''! parserError: aString "Evaluate the block. If it returns raise an error" self errorBlock value: aString value: self errorPosition. self error: aString! ! !RBParser methodsFor: 'private' stamp: 'pmm 7/12/2006 15:24'! patchLiteralMessage currentToken value == true ifTrue: [^currentToken := RBIdentifierToken value: 'true' start: currentToken start]. currentToken value == false ifTrue: [^currentToken := RBIdentifierToken value: 'false' start: currentToken start]. currentToken value isNil ifTrue: [^currentToken := RBIdentifierToken value: 'nil' start: currentToken start]! ! !RBParser methodsFor: 'private' stamp: 'pmm 7/12/2006 15:14'! patchNegativeLiteral "Handle the special negative number case for binary message sends." currentToken value isNumber ifFalse: [^self]. currentToken value <= 0 ifFalse: [^self]. currentToken value = 0 ifTrue: [(source notNil and: [source isEmpty not and: [(source at: (currentToken start min: source size)) == $-]]) ifFalse: [^self]]. nextToken := currentToken. currentToken := RBBinarySelectorToken value: #- start: nextToken start. nextToken value: nextToken value negated. nextToken start: nextToken start + 1! ! !RBParser methodsFor: 'initialize-release' stamp: 'md 10/11/2005 15:49'! scanner: aScanner scanner := aScanner. tags := nil. self initializeForSqueak. self step! ! !RBParser methodsFor: 'private' stamp: ''! step nextToken notNil ifTrue: [currentToken := nextToken. nextToken := nil. ^currentToken]. currentToken := scanner next! ! Object subclass: #RBProgramNode instanceVariableNames: 'parent properties annotations' classVariableNames: 'FormatterClass' poolDictionaries: '' category: 'AST-Nodes'! !RBProgramNode commentStamp: 'md 8/9/2005 14:59' prior: 0! RBProgramNode is an abstract class that represents an abstract syntax tree node in a Smalltalk program. Subclasses must implement the following messages: accessing start stop visitor acceptVisitor: The #start and #stop methods are used to find the source that corresponds to this node. "source copyFrom: self start to: self stop" should return the source for this node. The #acceptVisitor: method is used by RBProgramNodeVisitors (the visitor pattern). This will also require updating all the RBProgramNodeVisitors so that they know of the new node. Subclasses might also want to redefine match:inContext: and copyInContext: to do parse tree searching and replacing. Subclasses that contain other nodes should override equalTo:withMapping: to compare nodes while ignoring renaming temporary variables, and children that returns a collection of our children nodes. Instance Variables: comments the intervals in the source that have comments for this node parent the node we're contained in Shared Variables: FormatterClass the formatter class that is used when we are formatted! RBProgramNode subclass: #RBDoItNode instanceVariableNames: 'body source tags scope ir byteSurgeon' classVariableNames: '' poolDictionaries: '' category: 'AST-NodesExt'! !RBDoItNode class methodsFor: 'instance creation' stamp: 'ajh 3/11/2003 19:08'! body: aSequenceNode ^ self new body: aSequenceNode! ! !RBDoItNode methodsFor: 'comparing' stamp: 'ajh 2/26/2003 18:35'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. (self body = anObject body) ifFalse: [^false]. ^true! ! !RBDoItNode methodsFor: 'visitor' stamp: 'ajh 2/26/2003 18:31'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptDoItNode: self! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'! addNode: aNode ^body addNode: aNode! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'! addReturn body addReturn! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'! addSelfReturn ^body addSelfReturn! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'! body ^body! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'! body: stmtsNode body := stmtsNode. body parent: self! ! !RBDoItNode methodsFor: 'accessing' stamp: 'md 6/29/2005 12:21'! byteSurgeon byteSurgeon ifNil: [byteSurgeon := false]. ^byteSurgeon! ! !RBDoItNode methodsFor: 'accessing' stamp: 'md 6/29/2005 12:20'! byteSurgeon: boolean byteSurgeon := boolean.! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:28'! children ^ {self body}! ! !RBDoItNode methodsFor: 'matching' stamp: 'ajh 2/26/2003 18:24'! copyInContext: aDictionary ^(self class new) body: (body copyInContext: aDictionary); source: (aDictionary at: '-source-'); yourself! ! !RBDoItNode methodsFor: 'comparing' stamp: 'ajh 2/26/2003 18:35'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. (self body equalTo: anObject body withMapping: aDictionary) ifFalse: [^false]. ^self primitiveSources = anObject primitiveSources! ! !RBDoItNode methodsFor: 'semantics' stamp: 'ajh 7/8/2004 20:56'! freeNames "Filter out hidden ones that have space in there name such as 'top env'" ^ ((self freeVars collect: [:var | var name]) reject: [:name | name includes: $ ]) asSortedCollection! ! !RBDoItNode methodsFor: 'semantics' stamp: 'ajh 7/8/2004 20:59'! freeVars "Return children variable node bindings that refer to variables outside my scope (ignoring global vars)" | freeVars | freeVars := Set new. scope := self owningScope. self nodesDo: [:node | | var | (node isVariable or: [node isReturn and: [node binding notNil]]) ifTrue: [ var := node binding. (scope hasOuter: var scope) ifTrue: [ var isGlobal ifFalse: [ freeVars add: var]]]]. ^ freeVars! ! !RBDoItNode methodsFor: 'comparing' stamp: 'ajh 2/26/2003 18:36'! hash ^ self body hash! ! !RBDoItNode methodsFor: 'testing' stamp: 'ajh 6/29/2004 14:11'! isDoIt ^ true! ! !RBDoItNode methodsFor: 'testing' stamp: 'ajh 2/26/2003 18:22'! isLast: aNode ^body isLast: aNode! ! !RBDoItNode methodsFor: 'testing' stamp: 'ajh 2/26/2003 18:22'! lastIsReturn ^body lastIsReturn! ! !RBDoItNode methodsFor: 'matching' stamp: 'ajh 2/26/2003 18:28'! match: aNode inContext: aDictionary self class == aNode class ifFalse: [^false]. aDictionary at: '-source-' put: aNode source. ^ body match: aNode body inContext: aDictionary! ! !RBDoItNode methodsFor: 'semantics' stamp: 'ajh 6/30/2004 14:07'! owningBlock ^ self! ! !RBDoItNode methodsFor: 'semantics' stamp: 'ajh 3/13/2003 04:25'! owningScope ^ scope! ! !RBDoItNode methodsFor: 'copying' stamp: 'pmm 9/19/2005 11:29'! postCopy super postCopy. body := body copy. body parent: self. ! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'! primitiveSources ^self tags collect: [:each | self source copyFrom: each first to: each last]! ! !RBDoItNode methodsFor: 'printing' stamp: 'ajh 2/26/2003 18:22'! printOn: aStream aStream nextPutAll: self formattedCode! ! !RBDoItNode methodsFor: 'testing' stamp: 'ajh 2/26/2003 18:22'! references: aVariableName ^body references: aVariableName! ! !RBDoItNode methodsFor: 'replacing' stamp: 'ajh 2/26/2003 18:57'! replaceNode: aNode withNode: anotherNode aNode == body ifTrue: [self body: anotherNode]. ! ! !RBDoItNode methodsFor: 'semantics' stamp: 'ajh 3/16/2003 08:33'! scope ^ scope ifNil: [ self verifyIn: nil parseScope. scope ]! ! !RBDoItNode methodsFor: 'semantics' stamp: 'ajh 3/17/2003 15:34'! scope: aSemScope scope := aSemScope! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'! source ^source! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'! source: anObject source := anObject! ! !RBDoItNode methodsFor: 'debugging' stamp: 'ajh 6/29/2004 14:24'! sourceMap "Return a mapping from bytecode pcs to source code ranges" ^ self ir sourceMap! ! !RBDoItNode methodsFor: 'printing' stamp: 'ajh 6/29/2004 14:31'! sourceText ^ (self source ifNil: [self formattedCode]) asText! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'! start ^1! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'! stop ^source size! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'! tags ^tags isNil ifTrue: [#()] ifFalse: [tags]! ! !RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'! tags: aCollectionOfIntervals tags := aCollectionOfIntervals! ! !RBDoItNode methodsFor: 'debugging' stamp: 'ajh 6/29/2004 16:06'! tempNames "All temp names in context order" ^ self scope tempVars allButFirst "without receiver" collect: [:var | var name]! ! !RBDoItNode methodsFor: 'testing' stamp: 'ajh 2/26/2003 18:22'! uses: aNode ^body == aNode and: [aNode lastIsReturn]! ! RBProgramNode subclass: #RBMethodNode instanceVariableNames: 'selector selectorParts body source arguments scope primitiveNode methodProperties ir pragmas' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBMethodNode commentStamp: 'md 4/7/2007 20:16' prior: 0! RBMethodNode is the AST that represents a Smalltalk method. Instance Variables: arguments the arguments to the method body the body/statements of the method selector the method name (cached) selectorParts the tokens for the selector keywords source the source we compiled Properties: tags the source location of any resource/primitive tags ! !RBMethodNode class methodsFor: 'instance creation' stamp: ''! selector: aSymbol arguments: variableNodes body: aSequenceNode ^(self new) arguments: variableNodes; selector: aSymbol; body: aSequenceNode; yourself! ! !RBMethodNode class methodsFor: 'instance creation' stamp: ''! selector: aSymbol body: aSequenceNode ^self selector: aSymbol arguments: #() body: aSequenceNode! ! !RBMethodNode class methodsFor: 'instance creation' stamp: 'pmm 7/12/2006 15:20'! selectorParts: tokenCollection arguments: variableNodes ^((tokenCollection anySatisfy: [:each | each isPatternVariable]) ifTrue: [RBPatternMethodNode] ifFalse: [RBMethodNode]) new selectorParts: tokenCollection arguments: variableNodes! ! !RBMethodNode methodsFor: 'comparing' stamp: 'pmm 7/12/2006 15:42'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. (self selector = anObject selector and: [self body = anObject body]) ifFalse: [^false]. ^self arguments = anObject arguments! ! !RBMethodNode methodsFor: 'visitor' stamp: ''! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptMethodNode: self! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! addNode: aNode ^body addNode: aNode! ! !RBMethodNode methodsFor: 'accessing' stamp: 'ms 7/26/2006 21:52'! addPragma: aPragma self properties addPragma: aPragma! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! addReturn body addReturn! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! addSelfReturn ^body addSelfReturn! ! !RBMethodNode methodsFor: 'replacing' stamp: 'ajh 3/13/2003 16:13'! adjustPositionsAfter: sourcePos by: delta "Slide token positions after sourcePos by delta" selectorParts do: [:token | token start > sourcePos ifTrue: [ token start: token start + delta] ]. super adjustPositionsAfter: sourcePos by: delta. ! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! allArgumentVariables ^(self argumentNames asOrderedCollection) addAll: super allArgumentVariables; yourself! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! allDefinedVariables ^(self argumentNames asOrderedCollection) addAll: super allDefinedVariables; yourself! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! argumentNames ^self arguments collect: [:each | each name]! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! arguments ^arguments! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! arguments: variableNodes arguments := variableNodes. arguments do: [:each | each parent: self]! ! !RBMethodNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:31'! basicFirstToken ^self selectorParts first! ! !RBMethodNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:32'! basicLastToken ^self body lastToken ifNil:[^(RBPatternMethodNode selectorParts: self selectorParts arguments: self arguments) lastToken]! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! body ^body! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! body: stmtsNode body := stmtsNode. body parent: self! ! !RBMethodNode methodsFor: 'private' stamp: ''! buildSelector | selectorStream | selectorStream := WriteStream on: (String new: 50). selectorParts do: [:each | selectorStream nextPutAll: each value]. ^selectorStream contents asSymbol! ! !RBMethodNode methodsFor: 'accessing' stamp: 'ms 11/11/2006 19:22'! children ^(self arguments copyWith: self body), self pragmas! ! !RBMethodNode methodsFor: 'matching' stamp: ''! copyInContext: aDictionary ^(self class new) selectorParts: (selectorParts collect: [:each | each removePositions]); arguments: (arguments collect: [:each | each copyInContext: aDictionary]); body: (body copyInContext: aDictionary); source: (aDictionary at: '-source-'); yourself! ! !RBMethodNode methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:18'! defines: aName ^arguments anySatisfy: [:each | each name = aName]! ! !RBMethodNode methodsFor: 'comparing' stamp: 'pmm 7/12/2006 15:43'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. (self selector = anObject selector and: [self body equalTo: anObject body withMapping: aDictionary]) ifFalse: [^false]. self arguments with: anObject arguments do: [ :first :second | (first equalTo: second withMapping: aDictionary) ifFalse: [^false]. aDictionary removeKey: first name ]. ^self primitiveSources = anObject primitiveSources! ! !RBMethodNode methodsFor: 'comparing' stamp: ''! hash ^(self selector hash bitXor: self body hash) bitXor: self arguments hash! ! !RBMethodNode methodsFor: 'testing' stamp: ''! isLast: aNode ^body isLast: aNode! ! !RBMethodNode methodsFor: 'testing' stamp: ''! isMethod ^true! ! !RBMethodNode methodsFor: 'testing' stamp: 'ms 4/1/2007 13:47'! isPrimitive ^((self primitiveNode num = 0) not) or: [self pragmas inject: false into: [:bool :each | each isPrimitive | bool]]! ! !RBMethodNode methodsFor: 'testing' stamp: ''! lastIsReturn ^body lastIsReturn! ! !RBMethodNode methodsFor: 'accessing-token' stamp: 'ms 4/1/2007 17:34'! lastTokenOfPatternMethod ^self arguments ifEmpty: [^self selectorParts last] ifNotEmpty: [ ^self arguments last token]! ! !RBMethodNode methodsFor: 'matching' stamp: ''! match: aNode inContext: aDictionary self class == aNode class ifFalse: [^false]. aDictionary at: '-source-' put: aNode source. self selector == aNode selector ifFalse: [^false]. ^(self matchList: arguments against: aNode arguments inContext: aDictionary) and: [body match: aNode body inContext: aDictionary]! ! !RBMethodNode methodsFor: 'accessing' stamp: 'ajh 3/11/2003 19:58'! methodPatternStop ^ self arguments isEmpty ifTrue: [self selectorParts first stop] ifFalse: [self arguments last stop]! ! !RBMethodNode methodsFor: 'copying' stamp: 'pmm 12/5/2005 10:00'! postCopy super postCopy. body := body copy. body parent: self. arguments := arguments collect: [:each | each copy parent: self; yourself ]! ! !RBMethodNode methodsFor: 'accessing' stamp: 'ms 9/3/2006 23:54'! pragmas ^pragmas ifNil: [pragmas := OrderedCollection new]! ! !RBMethodNode methodsFor: 'accessing' stamp: 'ms 9/4/2006 00:04'! pragmas: aRBPragmasNode pragmas := aRBPragmasNode. pragmas do:[:each | each parent: self]! ! !RBMethodNode methodsFor: 'accessing' stamp: 'ajh 3/11/2003 18:27'! primitiveNode ^ primitiveNode ifNil: [PrimitiveNode null]! ! !RBMethodNode methodsFor: 'accessing' stamp: 'md 10/2/2006 17:23'! primitiveNode: aPrimitiveNode (primitiveNode isNil or: [ primitiveNode num = 0 ] or: [ primitiveNode num = aPrimitiveNode num ]) ifTrue: [ primitiveNode := aPrimitiveNode ] ifFalse: [ self notify: 'Ambigous primitives' ] ! ! !RBMethodNode methodsFor: 'accessing' stamp: 'ajh 3/19/2003 22:02'! primitiveSources | tgs text | tgs := self tags. tgs isEmpty ifTrue: [ text := self primitiveText. text isEmpty ifTrue: [^ #()]. ^ {text} ]. ^ tgs collect: [:each | self source copyFrom: each first to: each last]! ! !RBMethodNode methodsFor: 'accessing' stamp: 'ajh 3/11/2003 18:32'! primitiveStartPosition | set | set := self tags. set isEmpty ifTrue: [^ 0]. set size > 1 ifTrue: [self error: 'only one primitive string expected']. ^ set first first! ! !RBMethodNode methodsFor: 'accessing' stamp: 'ajh 3/19/2003 22:02'! primitiveText | set | self tags isEmpty ifTrue: [ ^ self primitiveNode ifNil: [''] ifNotNil: [self primitiveNode sourceText] ]. set := self primitiveSources. set size > 1 ifTrue: [self error: 'only one primitive string expected']. ^ set first ! ! !RBMethodNode methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: self formattedCode! ! !RBMethodNode methodsFor: 'accessing' stamp: 'md 4/1/2007 13:32'! properties ^methodProperties ifNil: [methodProperties := MethodProperties new]! ! !RBMethodNode methodsFor: 'accessing' stamp: 'md 4/1/2007 13:32'! properties: aMethodeProperties methodProperties := aMethodeProperties! ! !RBMethodNode methodsFor: 'testing' stamp: ''! references: aVariableName ^body references: aVariableName! ! !RBMethodNode methodsFor: 'replacing' stamp: ''! replaceNode: aNode withNode: anotherNode aNode == body ifTrue: [self body: anotherNode]. self arguments: (arguments collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! ! !RBMethodNode methodsFor: 'accessing' stamp: 'md 4/7/2007 10:20'! selector ^selector isNil ifTrue: [selector := self buildSelector] ifFalse: [selector]! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! selector: aSelector | keywords numArgs | keywords := aSelector keywords. numArgs := aSelector numArgs. numArgs == arguments size ifFalse: [self error: 'Attempting to assign selector with wrong number of arguments.']. selectorParts := numArgs == 0 ifTrue: [Array with: (RBIdentifierToken value: keywords first start: nil)] ifFalse: [keywords first last == $: ifTrue: [keywords collect: [:each | RBKeywordToken value: each start: nil]] ifFalse: [Array with: (RBBinarySelectorToken value: aSelector start: nil)]]. selector := aSelector! ! !RBMethodNode methodsFor: 'private' stamp: ''! selectorParts ^selectorParts! ! !RBMethodNode methodsFor: 'private' stamp: ''! selectorParts: tokenCollection selectorParts := tokenCollection! ! !RBMethodNode methodsFor: 'initialize-release' stamp: ''! selectorParts: tokenCollection arguments: variableNodes selectorParts := tokenCollection. self arguments: variableNodes! ! !RBMethodNode methodsFor: 'accessing' stamp: 'md 4/7/2007 11:31'! source ^source! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! source: anObject source := anObject! ! !RBMethodNode methodsFor: 'printing' stamp: 'ajh 2/27/2003 22:44'! sourceText ^ (self source ifNil: [self formattedCode]) asText! ! !RBMethodNode methodsFor: 'accessing' stamp: ''! start ^1! ! !RBMethodNode methodsFor: 'accessing' stamp: 'md 4/6/2007 11:22'! stop ^self source size! ! !RBMethodNode methodsFor: 'accessing' stamp: 'md 4/7/2007 20:15'! tags ^ self propertyAt: #tags ifAbsent: [#()].! ! !RBMethodNode methodsFor: 'accessing' stamp: 'md 4/7/2007 20:14'! tags: aCollectionOfIntervals aCollectionOfIntervals ifNil: [^self removeProperty: #tags ifAbsent: []]. self propertyAt: #tags put: aCollectionOfIntervals.! ! !RBMethodNode methodsFor: 'testing' stamp: ''! uses: aNode ^body == aNode and: [aNode lastIsReturn]! ! RBMethodNode subclass: #RBPatternMethodNode instanceVariableNames: 'isList' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBPatternMethodNode commentStamp: 'md 8/9/2005 14:59' prior: 0! RBPatternMethodNode is a RBMethodNode that will match other method nodes without their selectors being equal. Instance Variables: isList are we matching each keyword or matching all keywords together (e.g., `keyword1: would match a one argument method whereas `@keywords: would match 0 or more arguments) ! !RBPatternMethodNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:32'! basicLastToken self arguments ifEmpty: [^self selectorParts last] ifNotEmpty: [ ^self arguments last token]! ! !RBPatternMethodNode methodsFor: 'matching' stamp: ''! copyInContext: aDictionary | selectors | selectors := self isSelectorList ifTrue: [(aDictionary at: selectorParts first value) keywords] ifFalse: [selectorParts collect: [:each | aDictionary at: each value]]. ^(RBMethodNode new) selectorParts: (selectors collect: [:each | (each last == $: ifTrue: [RBKeywordToken] ifFalse: [RBIdentifierToken]) value: each start: nil]); arguments: (self copyList: arguments inContext: aDictionary); body: (body copyInContext: aDictionary); source: (aDictionary at: '-source-'); yourself! ! !RBPatternMethodNode methodsFor: 'testing-matching' stamp: ''! isPatternNode ^true! ! !RBPatternMethodNode methodsFor: 'testing' stamp: ''! isSelectorList ^isList! ! !RBPatternMethodNode methodsFor: 'matching' stamp: ''! match: aNode inContext: aDictionary aNode class == self matchingClass ifFalse: [^false]. aDictionary at: '-source-' put: aNode source. self isSelectorList ifTrue: [^(aDictionary at: selectorParts first value ifAbsentPut: [aNode selector]) = aNode selector and: [(aDictionary at: arguments first ifAbsentPut: [aNode arguments]) = aNode arguments and: [body match: aNode body inContext: aDictionary]]]. ^(self matchArgumentsAgainst: aNode inContext: aDictionary) and: [body match: aNode body inContext: aDictionary]! ! !RBPatternMethodNode methodsFor: 'matching' stamp: 'pmm 7/12/2006 15:45'! matchArgumentsAgainst: aNode inContext: aDictionary self arguments size == aNode arguments size ifFalse: [^false]. (self matchSelectorAgainst: aNode inContext: aDictionary) ifFalse: [^false]. self arguments with: aNode arguments do: [ :first :second | (first match: second inContext: aDictionary) ifFalse: [^false]]. ^true! ! !RBPatternMethodNode methodsFor: 'matching' stamp: ''! matchSelectorAgainst: aNode inContext: aDictionary | keyword | 1 to: selectorParts size do: [:i | keyword := selectorParts at: i. (aDictionary at: keyword value ifAbsentPut: [keyword isPatternVariable ifTrue: [(aNode selectorParts at: i) value] ifFalse: [keyword value]]) = (aNode selectorParts at: i) value ifFalse: [^false]]. ^true! ! !RBPatternMethodNode methodsFor: 'private' stamp: ''! matchingClass ^RBMethodNode! ! !RBPatternMethodNode methodsFor: 'initialize-release' stamp: ''! selectorParts: tokenCollection arguments: variableNodes super selectorParts: tokenCollection arguments: variableNodes. isList := (tokenCollection first value at: 2) == self listCharacter! ! RBProgramNode subclass: #RBPragmaNode instanceVariableNames: 'pragma spec primitiveNumber start stop' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBPragmaNode class methodsFor: 'instance creation' stamp: 'ms 9/17/2006 01:50'! pragma: aPragma spec: aSpec start: startPosition stop: stopPosition ^self new pragma: aPragma spec: aSpec start: startPosition stop: stopPosition! ! !RBPragmaNode class methodsFor: 'instance creation' stamp: 'ms 9/17/2006 01:41'! pragma: aPragma spec: aSpec start: startPosition stop: stopPosition firstToken: fToken lastToken: lToken ^self new pragma: aPragma spec: aSpec start: startPosition stop: stopPosition firstToken: fToken lastToken: lToken ! ! !RBPragmaNode methodsFor: 'visitor' stamp: 'ms 9/4/2006 00:06'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptPragmaNode: self! ! !RBPragmaNode methodsFor: 'testing' stamp: 'pmm 10/4/2006 14:23'! isPrimitive ^#( primitive: primitive:module: ) includes: self pragma keyword! ! !RBPragmaNode methodsFor: 'accessing' stamp: 'pmm 10/4/2006 14:12'! method ^self parent! ! !RBPragmaNode methodsFor: 'accessing' stamp: 'ms 9/2/2006 18:30'! pragma ^pragma! ! !RBPragmaNode methodsFor: 'accessing' stamp: 'ms 9/17/2006 01:50'! pragma: aPragma spec: aSpec start: startPosition stop: stopPosition pragma := aPragma. spec := aSpec. start := startPosition. stop := stopPosition! ! !RBPragmaNode methodsFor: 'accessing' stamp: 'md 4/6/2007 20:15'! pragma: aPragma spec: aSpec start: startPosition stop: stopPosition firstToken: fToken lastToken: lToken pragma := aPragma. spec := aSpec. start := startPosition. stop := stopPosition. self firstToken: fToken. self lastToken: lToken! ! !RBPragmaNode methodsFor: 'accessing' stamp: 'pmm 10/4/2006 14:24'! primitive ^self isPrimitive ifTrue:[ PrimitiveNode new num: self primitiveNumber; spec: self spec; yourself] ifFalse:[ PrimitiveNode null ] ! ! !RBPragmaNode methodsFor: 'accessing' stamp: 'ms 9/3/2006 23:36'! primitiveNumber ^primitiveNumber ifNil:[primitiveNumber := 0]! ! !RBPragmaNode methodsFor: 'accessing' stamp: 'ms 9/2/2006 18:42'! primitiveNumber: aNum primitiveNumber := aNum! ! !RBPragmaNode methodsFor: 'accessing' stamp: 'ms 9/2/2006 18:31'! spec ^spec! ! !RBPragmaNode methodsFor: 'accessing' stamp: 'ms 9/2/2006 18:43'! start ^start! ! !RBPragmaNode methodsFor: 'accessing' stamp: 'ms 9/2/2006 18:43'! stop ^stop! ! !RBProgramNode class methodsFor: 'accessing' stamp: 'nk 1/29/2005 10:25'! colorFormatterClass ^Smalltalk at: #RBColorFormatter ifAbsent: [ self formatterClass ]! ! !RBProgramNode class methodsFor: 'accessing' stamp: ''! formatterClass ^FormatterClass isNil ifTrue: [RBFormatter] ifFalse: [FormatterClass]! ! !RBProgramNode class methodsFor: 'accessing' stamp: ''! formatterClass: aClass FormatterClass := aClass! ! !RBProgramNode class methodsFor: 'accessing' stamp: 'md 10/11/2005 15:08'! initialize "self initialize" Preferences addPreference: #useRBASTForPrettyPrint categories: #(#browsing ) default: false balloonHelp: 'if set, the RB AST formatter will be used for pretty-printing'! ! !RBProgramNode class methodsFor: 'accessing' stamp: ''! optimizedSelectors ^#(#== #ifTrue: #ifTrue:ifFalse: #ifFalse: #ifFalse:ifTrue: #whileTrue: #whileTrue #whileFalse: #whileFalse #to:do: #yourself #and: #or:)! ! !RBProgramNode class methodsFor: 'accessing' stamp: 'md 10/11/2005 15:09'! unload Preferences removePreference: #useRBASTForPrettyPrint ! ! !RBProgramNode methodsFor: 'visitor' stamp: 'rr 4/10/2004 16:54'! acceptVisitor: aProgramNodeVisitor "self subclassResponsibility"! ! !RBProgramNode methodsFor: 'replacing' stamp: 'ajh 3/13/2003 16:09'! adjustPositionsAfter: sourcePos by: delta "Slide token positions after sourcePos by delta" self children do: [:node | node adjustPositionsAfter: sourcePos by: delta]! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! allArgumentVariables | children | children := self children. children isEmpty ifTrue: [^#()]. ^children inject: OrderedCollection new into: [:vars :each | vars addAll: each allArgumentVariables; yourself]! ! !RBProgramNode methodsFor: 'iterating' stamp: 'bh 3/13/2000 01:48'! allChildren ^self children inject:(OrderedCollection new addAll:self children; yourself) into:[:answer :child| answer addAll:child allChildren; yourself].! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! allDefinedVariables | children | children := self children. children isEmpty ifTrue: [^#()]. ^children inject: OrderedCollection new into: [:vars :each | vars addAll: each allDefinedVariables; yourself]! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! allTemporaryVariables | children | children := self children. children isEmpty ifTrue: [^#()]. ^children inject: OrderedCollection new into: [:vars :each | vars addAll: each allTemporaryVariables; yourself]! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! asReturn "Change the current node to a return node." parent isNil ifTrue: [self error: 'Cannot change to a return without a parent node.']. parent isSequence ifFalse: [self error: 'Parent node must be a sequence node.']. (parent isLast: self) ifFalse: [self error: 'Return node must be last.']. ^parent addReturn! ! !RBProgramNode methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:20'! assigns: aVariableName ^self children anySatisfy: [:each | each assigns: aVariableName]! ! !RBProgramNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:28'! basicFirstToken ^self subclassResponsibility! ! !RBProgramNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:29'! basicLastToken ^self subclassResponsibility! ! !RBProgramNode methodsFor: 'querying' stamp: ''! bestNodeFor: anInterval | selectedChildren | (self intersectsInterval: anInterval) ifFalse: [^nil]. (self containedBy: anInterval) ifTrue: [^self]. selectedChildren := self children select: [:each | each intersectsInterval: anInterval]. ^selectedChildren size == 1 ifTrue: [selectedChildren first bestNodeFor: anInterval] ifFalse: [self]! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! blockVariables ^parent isNil ifTrue: [#()] ifFalse: [parent blockVariables]! ! !RBProgramNode methodsFor: 'testing-matching' stamp: 'pmm 7/12/2006 16:06'! canMatchMethod: aCompiledMethod ^self sentMessages allSatisfy: [:each | (self class optimizedSelectors includes: each) or: [aCompiledMethod refersToLiteral: each]].! ! !RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''! cascadeListCharacter ^$;! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! children ^#()! ! !RBProgramNode methodsFor: 'enumeration' stamp: ''! collect: aBlock "Hacked to fit collection protocols" ^aBlock value: self! ! !RBProgramNode methodsFor: 'accessing' stamp: 'nk 1/29/2005 10:24'! colorFormatterClass ^self class colorFormatterClass! ! !RBProgramNode methodsFor: 'accessing' stamp: 'nk 1/29/2005 10:23'! colorizedFormattedCode ^self colorFormatterClass new format: self! ! !RBProgramNode methodsFor: 'accessing' stamp: 'md 4/6/2007 20:02'! comment ^ self comments isEmpty ifTrue: [nil] ifFalse: [self comments first]! ! !RBProgramNode methodsFor: 'accessing' stamp: 'ms 4/7/2007 02:59'! comments ^self propertyAt: #comments ifAbsentPut: [OrderedCollection new].! ! !RBProgramNode methodsFor: 'accessing' stamp: 'md 4/6/2007 22:50'! comments: aCollection aCollection isNil ifTrue: [^self removeProperty: #comments ifAbsent:[]]. self propertyAt: #comments put: aCollection. ! ! !RBProgramNode methodsFor: 'testing' stamp: ''! containedBy: anInterval ^anInterval first <= self start and: [anInterval last >= self stop]! ! !RBProgramNode methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:21'! containsReturn ^self children anySatisfy: [:each | each containsReturn]! ! !RBProgramNode methodsFor: 'copying' stamp: ''! copyCommentsFrom: aNode "Add all comments from aNode to us. If we already have the comment, then don't add it." | newComments | newComments := OrderedCollection new. aNode nodesDo: [:each | newComments addAll: each comments]. self nodesDo: [:each | each comments do: [:comment | newComments remove: comment ifAbsent: []]]. newComments isEmpty ifTrue: [^self]. newComments := newComments asSortedCollection: [:a :b | a first < b first]. self comments: newComments! ! !RBProgramNode methodsFor: 'matching' stamp: ''! copyInContext: aDictionary ^self copy! ! !RBProgramNode methodsFor: 'matching' stamp: ''! copyList: matchNodes inContext: aDictionary | newNodes | newNodes := OrderedCollection new. matchNodes do: [:each | | object | object := each copyInContext: aDictionary. newNodes addAll: object]. ^newNodes! ! !RBProgramNode methodsFor: 'accessing' stamp: 'ajh 3/15/2003 15:17'! debugHighlightStart ^ self start! ! !RBProgramNode methodsFor: 'accessing' stamp: 'ajh 3/15/2003 15:18'! debugHighlightStop ^ self stop! ! !RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/15/2003 14:57'! decompileString ^ self formattedCode! ! !RBProgramNode methodsFor: 'testing' stamp: ''! defines: aName ^false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! directlyUses: aNode ^true! ! !RBProgramNode methodsFor: 'enumeration' stamp: ''! do: aBlock "Hacked to fit collection protocols" aBlock value: self! ! !RBProgramNode methodsFor: 'comparing' stamp: ''! equalTo: aNode exceptForVariables: variableNameCollection | dictionary | dictionary := Dictionary new. (self equalTo: aNode withMapping: dictionary) ifFalse: [^false]. dictionary keysAndValuesDo: [:key :value | (key = value or: [variableNameCollection includes: key]) ifFalse: [^false]]. ^true! ! !RBProgramNode methodsFor: 'comparing' stamp: ''! equalTo: aNode withMapping: aDictionary ^self = aNode! ! !RBProgramNode methodsFor: 'testing' stamp: ''! evaluatedFirst: aNode self children do: [:each | each == aNode ifTrue: [^true]. each isImmediate ifFalse: [^false]]. ^false! ! !RBProgramNode methodsFor: 'accessing-token' stamp: 'md 4/6/2007 20:14'! firstToken ^self propertyAt: #firstToken ifAbsent: [self basicFirstToken].! ! !RBProgramNode methodsFor: 'accessing-token' stamp: 'md 4/6/2007 20:14'! firstToken: aToken self propertyAt: #firstToken put: aToken.! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! formattedCode ^self formatterClass new format: self! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! formatterClass ^self class formatterClass! ! !RBProgramNode methodsFor: 'testing' stamp: 'pmm 9/24/2005 10:53'! hasParent ^self parent notNil! ! !RBProgramNode methodsFor: 'properties' stamp: 'md 4/1/2007 13:35'! hasProperty: aKey "Test if the property aKey is present." ^ properties notNil and: [ properties includesKey: aKey ].! ! !RBProgramNode methodsFor: 'testing' stamp: ''! intersectsInterval: anInterval ^(anInterval first between: self start and: self stop) or: [self start between: anInterval first and: anInterval last]! ! !RBProgramNode methodsFor: 'testing' stamp: 'ajh 2/25/2003 14:34'! isArray ^false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isAssignment ^false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isBlock ^false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isCascade ^false! ! !RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/4/2003 00:50'! isCaseBranch ^ false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isDirectlyUsed "This node is directly used as an argument, receiver, or part of an assignment." ^parent isNil ifTrue: [false] ifFalse: [parent directlyUses: self]! ! !RBProgramNode methodsFor: 'testing' stamp: 'ajh 6/29/2004 14:12'! isDoIt ^ false! ! !RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/2/2003 23:22'! isDup ^ false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isEvaluatedFirst "Return true if we are the first thing evaluated in this statement." ^parent isNil or: [parent isSequence or: [parent evaluatedFirst: self]]! ! !RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/2/2003 23:22'! isGoto ^ false! ! !RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/1/2003 20:12'! isIf ^ false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isImmediate ^false! ! !RBProgramNode methodsFor: 'inline' stamp: 'ajh 2/25/2003 19:48'! isInline ^ false! ! !RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/2/2003 23:22'! isLabel ^ false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isLast: aNode | children | children := self children. ^children isEmpty not and: [children last == aNode]! ! !RBProgramNode methodsFor: 'testing-matching' stamp: ''! isList ^false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isLiteral ^false! ! !RBProgramNode methodsFor: 'testing' stamp: 'ajh 3/3/2003 22:28'! isLiteral: valueTestBlock ^false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isMessage ^false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isMethod ^false! ! !RBProgramNode methodsFor: 'testing-matching' stamp: ''! isPatternNode ^false! ! !RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/2/2003 23:22'! isPop ^ false! ! !RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/3/2003 18:42'! isPseudo ^ false! ! !RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/23/2003 22:23'! isPseudoSend ^ false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isReturn ^false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isSequence ^false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isUsed "Answer true if this node could be used as part of another expression. For example, you could use the result of this node as a receiver of a message, an argument, the right part of an assignment, or the return value of a block. This differs from isDirectlyUsed in that it is conservative since it also includes return values of blocks." ^parent isNil ifTrue: [false] ifFalse: [parent uses: self]! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isValue ^false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! isVariable ^false! ! !RBProgramNode methodsFor: 'testing' stamp: ''! lastIsReturn ^self isReturn! ! !RBProgramNode methodsFor: 'accessing-token' stamp: 'md 4/6/2007 20:14'! lastToken ^self propertyAt: #lastToken ifAbsent: [self basicLastToken].! ! !RBProgramNode methodsFor: 'accessing-token' stamp: 'md 4/6/2007 20:14'! lastToken: aToken self propertyAt: #lastToken put: aToken.! ! !RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''! listCharacter ^$@! ! !RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''! literalCharacter ^$#! ! !RBProgramNode methodsFor: 'matching' stamp: ''! match: aNode inContext: aDictionary ^self = aNode! ! !RBProgramNode methodsFor: 'matching' stamp: ''! matchList: matchNodes against: programNodes inContext: aDictionary ^self matchList: matchNodes index: 1 against: programNodes index: 1 inContext: aDictionary! ! !RBProgramNode methodsFor: 'matching' stamp: ''! matchList: matchNodes index: matchIndex against: programNodes index: programIndex inContext: aDictionary | node currentIndex currentDictionary nodes | matchNodes size < matchIndex ifTrue: [^programNodes size < programIndex]. node := matchNodes at: matchIndex. node isList ifTrue: [currentIndex := programIndex - 1. [currentDictionary := aDictionary copy. programNodes size < currentIndex or: [nodes := programNodes copyFrom: programIndex to: currentIndex. (currentDictionary at: node ifAbsentPut: [nodes]) = nodes and: [(self matchList: matchNodes index: matchIndex + 1 against: programNodes index: currentIndex + 1 inContext: currentDictionary) ifTrue: [currentDictionary keysAndValuesDo: [:key :value | aDictionary at: key put: value]. ^true]. false]]] whileFalse: [currentIndex := currentIndex + 1]. ^false]. programNodes size < programIndex ifTrue: [^false]. (node match: (programNodes at: programIndex) inContext: aDictionary) ifFalse: [^false]. ^self matchList: matchNodes index: matchIndex + 1 against: programNodes index: programIndex + 1 inContext: aDictionary! ! !RBProgramNode methodsFor: 'querying' stamp: 'nk 2/24/2005 14:28'! methodNode (parent isNil or: [self isMethod]) ifTrue: [^self]. ^parent methodNode! ! !RBProgramNode methodsFor: 'iterating' stamp: ''! nodesDo: aBlock aBlock value: self. self children do: [:each | each nodesDo: aBlock]! ! !RBProgramNode methodsFor: 'semantics' stamp: 'ajh 6/30/2004 14:08'! owningBlock ^ parent owningBlock! ! !RBProgramNode methodsFor: 'semantics' stamp: 'ajh 3/13/2003 04:19'! owningScope ^ parent owningScope! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! parent ^parent! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! parent: anObject parent := anObject! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! precedence ^6! ! !RBProgramNode methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: self class name; nextPut: $(; nextPutAll: self formattedCode; nextPut: $)! ! !RBProgramNode methodsFor: 'properties' stamp: 'md 3/29/2007 14:48'! propertyAt: aKey "Answer the property value associated with aKey." ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ].! ! !RBProgramNode methodsFor: 'properties' stamp: 'md 4/1/2007 13:36'! propertyAt: aKey ifAbsent: aBlock "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock." properties isNil ifTrue: [ ^ aBlock value ]. ^ properties at: aKey ifAbsent: aBlock.! ! !RBProgramNode methodsFor: 'properties' stamp: 'md 3/29/2007 14:48'! propertyAt: aKey ifAbsentPut: aBlock "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value." ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ].! ! !RBProgramNode methodsFor: 'properties' stamp: 'md 4/7/2007 12:39'! propertyAt: aKey put: anObject "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject." properties ifNil: [ properties := RBSmallIdentityDictionary new: 1]. ^ properties at: aKey put: anObject! ! !RBProgramNode methodsFor: 'testing-matching' stamp: ''! recurseInto ^false! ! !RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''! recurseIntoCharacter ^$`! ! !RBProgramNode methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:21'! references: aVariableName ^self children anySatisfy: [:each | each references: aVariableName]! ! !RBProgramNode methodsFor: 'replacing' stamp: ''! removeDeadCode self children do: [:each | each removeDeadCode]! ! !RBProgramNode methodsFor: 'properties' stamp: 'md 3/29/2007 14:51'! removeProperty: aKey "Remove the property with aKey. Answer the property or raise an error if aKey isn't found." ^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ].! ! !RBProgramNode methodsFor: 'properties' stamp: 'md 4/1/2007 13:36'! removeProperty: aKey ifAbsent: aBlock "Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock." | answer | properties isNil ifTrue: [ ^ aBlock value ]. answer := properties removeKey: aKey ifAbsent: aBlock. properties isEmpty ifTrue: [ properties := nil ]. ^ answer.! ! !RBProgramNode methodsFor: 'replacing' stamp: ''! replaceNode: aNode withNode: anotherNode self error: 'I don''t store other nodes'! ! !RBProgramNode methodsFor: 'replacing' stamp: ''! replaceWith: aNode parent isNil ifTrue: [self error: 'This node doesn''t have a parent']. parent replaceNode: self withNode: aNode! ! !RBProgramNode methodsFor: 'querying' stamp: 'ajh 2/27/2003 22:40'! root ^ parent ifNil: [self] ifNotNil: [parent root]! ! !RBProgramNode methodsFor: 'querying' stamp: ''! selfMessages | searcher | searcher := ParseTreeSearcher new. searcher matches: 'self `@msg: ``@args' do: [:aNode :answer | answer add: aNode selector; yourself]. ^searcher executeTree: self initialAnswer: Set new! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! sentMessages | messages | messages := Set new. self children do: [:each | messages addAll: each sentMessages]. ^messages! ! !RBProgramNode methodsFor: 'printing' stamp: 'md 7/28/2006 15:25'! shortPrintOn: aStream aStream nextPutAll: self formattedCode.! ! !RBProgramNode methodsFor: 'enumeration' stamp: ''! size "Hacked to fit collection protocols" ^1! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! source ^parent notNil ifTrue: [parent source] ifFalse: [nil]! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! sourceInterval ^self start to: self stop! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! start self subclassResponsibility! ! !RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''! statementCharacter ^$.! ! !RBProgramNode methodsFor: 'querying' stamp: ''! statementNode "Return your topmost node that is contained by a sequence node." (parent isNil or: [parent isSequence]) ifTrue: [^self]. ^parent statementNode! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! stop self subclassResponsibility! ! !RBProgramNode methodsFor: 'querying' stamp: ''! superMessages | searcher | searcher := ParseTreeSearcher new. searcher matches: 'super `@msg: ``@args' do: [:aNode :answer | answer add: aNode selector; yourself]. ^searcher executeTree: self initialAnswer: Set new! ! !RBProgramNode methodsFor: 'accessing' stamp: ''! temporaryVariables ^parent isNil ifTrue: [#()] ifFalse: [parent temporaryVariables]! ! !RBProgramNode methodsFor: 'testing' stamp: ''! uses: aNode ^true! ! !RBProgramNode methodsFor: 'querying' stamp: ''! whichNodeIsContainedBy: anInterval | selectedChildren | (self intersectsInterval: anInterval) ifFalse: [^nil]. (self containedBy: anInterval) ifTrue: [^self]. selectedChildren := self children select: [:each | each intersectsInterval: anInterval]. ^selectedChildren size == 1 ifTrue: [selectedChildren first whichNodeIsContainedBy: anInterval] ifFalse: [nil]! ! !RBProgramNode methodsFor: 'querying' stamp: ''! whoDefines: aName ^(self defines: aName) ifTrue: [self] ifFalse: [parent notNil ifTrue: [parent whoDefines: aName] ifFalse: [nil]]! ! RBProgramNode subclass: #RBPseudoNode instanceVariableNames: 'mapInstr' classVariableNames: '' poolDictionaries: '' category: 'AST-NodesExt'! !RBPseudoNode commentStamp: 'ajh 6/27/2004 15:13' prior: 0! Used by IRDecompiler to represent intermediate nodes that eventually get reduced to real parse nodes.! RBPseudoNode subclass: #RBPseudoBlockNode instanceVariableNames: 'block successor arguments' classVariableNames: '' poolDictionaries: '' category: 'AST-NodesExt'! !RBPseudoBlockNode methodsFor: 'accessing' stamp: 'md 11/17/2004 12:20'! arguments ^arguments! ! !RBPseudoBlockNode methodsFor: 'accessing' stamp: 'md 11/17/2004 12:20'! arguments: aCollection arguments := aCollection! ! !RBPseudoBlockNode methodsFor: 'accessing' stamp: 'md 10/21/2004 14:58'! block ^ block.! ! !RBPseudoBlockNode methodsFor: 'accessing' stamp: 'md 10/21/2004 14:59'! block: aSeqNum block := aSeqNum.! ! !RBPseudoBlockNode methodsFor: 'testing' stamp: 'md 10/21/2004 15:01'! isBlock ^true.! ! !RBPseudoBlockNode methodsFor: 'accessing' stamp: 'md 10/21/2004 14:59'! successor ^successor.! ! !RBPseudoBlockNode methodsFor: 'accessing' stamp: 'md 10/21/2004 14:59'! successor: aSeqNum successor := aSeqNum.! ! RBPseudoNode subclass: #RBPseudoDupNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-NodesExt'! !RBPseudoDupNode methodsFor: 'testing' stamp: 'ajh 3/2/2003 23:24'! isDup ^ true! ! RBPseudoNode subclass: #RBPseudoGotoNode instanceVariableNames: 'destination forValue' classVariableNames: '' poolDictionaries: '' category: 'AST-NodesExt'! !RBPseudoGotoNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/3/2003 21:20'! destination ^ destination! ! !RBPseudoGotoNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/9/2003 13:44'! destination: seqNum destination := seqNum! ! !RBPseudoGotoNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/20/2003 01:16'! forValue "true if sequence before me is for value, false if for effect" ^ forValue and: [self isRet not]! ! !RBPseudoGotoNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/4/2003 22:18'! forValue: boolean "true if sequence before me is for value, false if for effect" forValue := boolean! ! !RBPseudoGotoNode methodsFor: 'testing' stamp: 'ajh 3/2/2003 23:23'! isGoto ^ true! ! !RBPseudoGotoNode methodsFor: 'testing' stamp: 'ajh 3/20/2003 19:05'! isRet "is return" ^ self destination = #return! ! RBPseudoNode subclass: #RBPseudoIfNode instanceVariableNames: 'boolean destination otherwise' classVariableNames: '' poolDictionaries: '' category: 'AST-NodesExt'! !RBPseudoIfNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/3/2003 21:20'! boolean ^ boolean! ! !RBPseudoIfNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/1/2003 23:08'! boolean: bool boolean := bool! ! !RBPseudoIfNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/3/2003 21:20'! destination ^ destination! ! !RBPseudoIfNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/9/2003 13:45'! destination: seqNum destination := seqNum! ! !RBPseudoIfNode methodsFor: 'testing' stamp: 'ajh 3/1/2003 20:13'! isIf ^ true! ! !RBPseudoIfNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/3/2003 21:20'! otherwise ^ otherwise! ! !RBPseudoIfNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/2/2003 23:19'! otherwise: instructionSequence otherwise := instructionSequence! ! RBPseudoNode subclass: #RBPseudoLabelNode instanceVariableNames: 'destination' classVariableNames: '' poolDictionaries: '' category: 'AST-NodesExt'! !RBPseudoLabelNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/3/2003 21:21'! destination ^ destination! ! !RBPseudoLabelNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/9/2003 13:45'! destination: seqNum destination := seqNum! ! !RBPseudoLabelNode methodsFor: 'testing' stamp: 'ajh 3/2/2003 23:23'! isLabel ^ true! ! !RBPseudoNode methodsFor: 'visitor' stamp: 'ajh 3/17/2003 00:25'! acceptVisitor: aProgramNodeVisitor ^ aProgramNodeVisitor acceptPseudoNode: self! ! !RBPseudoNode methodsFor: 'testing' stamp: 'md 10/21/2004 15:01'! isBlock ^false.! ! !RBPseudoNode methodsFor: 'testing' stamp: 'ajh 3/3/2003 18:41'! isPseudo ^ true! ! !RBPseudoNode methodsFor: 'accessing' stamp: 'ajh 3/20/2003 17:20'! mapInstr ^ mapInstr! ! !RBPseudoNode methodsFor: 'accessing' stamp: 'ajh 3/20/2003 17:19'! mapInstr: irInstr mapInstr := irInstr! ! RBPseudoNode subclass: #RBPseudoPopNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-NodesExt'! !RBPseudoPopNode methodsFor: 'testing' stamp: 'ajh 3/2/2003 23:23'! isPop ^ true! ! RBPseudoNode subclass: #RBPseudoSendNode instanceVariableNames: 'selector arguments' classVariableNames: '' poolDictionaries: '' category: 'AST-NodesExt'! !RBPseudoSendNode methodsFor: 'accessing' stamp: 'md 11/15/2004 18:07'! arguments ^arguments! ! !RBPseudoSendNode methodsFor: 'accessing' stamp: 'md 11/15/2004 18:07'! arguments: aCollection arguments:= aCollection.! ! !RBPseudoSendNode methodsFor: 'testing' stamp: 'ajh 3/23/2003 22:23'! isPseudoSend ^ true! ! !RBPseudoSendNode methodsFor: 'accessing' stamp: 'ajh 3/23/2003 22:23'! selector ^ selector! ! !RBPseudoSendNode methodsFor: 'accessing' stamp: 'ajh 3/23/2003 22:23'! selector: aSelector selector := aSelector! ! RBProgramNode subclass: #RBReturnNode instanceVariableNames: 'return value' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBReturnNode commentStamp: 'md 8/9/2005 14:59' prior: 0! RBReturnNode is an AST node that represents a return expression. Instance Variables: return the position of the ^ character value the value that is being returned ! !RBReturnNode class methodsFor: 'instance creation' stamp: ''! return: returnInteger value: aValueNode ^self new return: returnInteger value: aValueNode! ! !RBReturnNode class methodsFor: 'instance creation' stamp: ''! value: aNode ^self return: nil value: aNode! ! !RBReturnNode methodsFor: 'comparing' stamp: ''! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. ^self value = anObject value! ! !RBReturnNode methodsFor: 'visitor' stamp: ''! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptReturnNode: self! ! !RBReturnNode methodsFor: 'replacing' stamp: 'ajh 3/19/2003 16:16'! adjustPositionsAfter: sourcePos by: delta "Slide token positions after sourcePos by delta" self return: return + delta. super adjustPositionsAfter: sourcePos by: delta. ! ! !RBReturnNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:34'! basicFirstToken ^self value firstToken! ! !RBReturnNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:34'! basicLastToken ^self value lastToken! ! !RBReturnNode methodsFor: 'semantics' stamp: 'ajh 7/8/2004 20:57'! binding ^ self homeBinding! ! !RBReturnNode methodsFor: 'accessing' stamp: ''! children ^Array with: value! ! !RBReturnNode methodsFor: 'testing' stamp: ''! containsReturn ^true! ! !RBReturnNode methodsFor: 'matching' stamp: ''! copyInContext: aDictionary ^(self class new) value: (value copyInContext: aDictionary); yourself! ! !RBReturnNode methodsFor: 'comparing' stamp: ''! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. ^self value equalTo: anObject value withMapping: aDictionary! ! !RBReturnNode methodsFor: 'comparing' stamp: ''! hash ^self value hash! ! !RBReturnNode methodsFor: 'semantics' stamp: 'md 4/3/2007 13:41'! homeBinding ^ self propertyAt: #binding ifAbsent: [nil].! ! !RBReturnNode methodsFor: 'semantics' stamp: 'md 4/3/2007 13:42'! homeBinding: aSemVar aSemVar ifNil: [^self removeProperty: #binding ifAbsent: []]. self propertyAt: #binding put: aSemVar.! ! !RBReturnNode methodsFor: 'testing' stamp: ''! isReturn ^true! ! !RBReturnNode methodsFor: 'matching' stamp: ''! match: aNode inContext: aDictionary aNode class == self class ifFalse: [^false]. ^value match: aNode value inContext: aDictionary! ! !RBReturnNode methodsFor: 'copying' stamp: 'pmm 9/19/2005 11:30'! postCopy super postCopy. value := value copy. value parent: self! ! !RBReturnNode methodsFor: 'replacing' stamp: ''! replaceNode: aNode withNode: anotherNode value == aNode ifTrue: [self value: anotherNode]! ! !RBReturnNode methodsFor: 'initialize-release' stamp: 'ajh 3/19/2003 13:51'! return: returnInteger return := returnInteger! ! !RBReturnNode methodsFor: 'initialize-release' stamp: ''! return: returnInteger value: aValueNode return := returnInteger. self value: aValueNode! ! !RBReturnNode methodsFor: 'accessing' stamp: ''! start ^return! ! !RBReturnNode methodsFor: 'accessing' stamp: ''! stop ^value stop! ! !RBReturnNode methodsFor: 'accessing' stamp: ''! value ^value! ! !RBReturnNode methodsFor: 'accessing' stamp: ''! value: valueNode value := valueNode. value parent: self! ! RBProgramNode subclass: #RBSequenceNode instanceVariableNames: 'statements temporaries' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBSequenceNode commentStamp: 'md 4/7/2007 20:30' prior: 0! RBSequenceNode is an AST node that represents a sequence of statements. Both RBBlockNodes and RBMethodNodes contain these. Instance Variables: statements the statement nodes temporaries the temporaries defined Properties: leftBar the position of the left | in the temporaries definition rightBar the position of the right | in the temporaries definition periods the positions of all the periods that separate the statements ! !RBSequenceNode class methodsFor: 'instance creation' stamp: ''! leftBar: leftInteger temporaries: variableNodes rightBar: rightInteger ^self new leftBar: leftInteger temporaries: variableNodes rightBar: rightInteger! ! !RBSequenceNode class methodsFor: 'instance creation' stamp: ''! statements: statementNodes ^self temporaries: #() statements: statementNodes! ! !RBSequenceNode class methodsFor: 'instance creation' stamp: ''! temporaries: variableNodes statements: statementNodes ^(self new) temporaries: variableNodes; statements: statementNodes; yourself! ! !RBSequenceNode methodsFor: 'comparing' stamp: 'pmm 7/12/2006 15:45'! = anObject "Can't send = to the temporaries and statements collection since they might change from arrays to OCs" self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. self temporaries size = anObject temporaries size ifFalse: [^false]. ^self temporaries = anObject temporaries and: [ self statements = anObject statements ]! ! !RBSequenceNode methodsFor: 'visitor' stamp: ''! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptSequenceNode: self! ! !RBSequenceNode methodsFor: 'adding nodes' stamp: ''! addNode: aNode aNode parent: self. (statements isEmpty not and: [statements last isReturn]) ifTrue: [self error: 'Cannot add statement after return node']. statements := statements asOrderedCollection add: aNode; yourself! ! !RBSequenceNode methodsFor: 'adding nodes' stamp: 'pmm 9/19/2005 17:54'! addNode: aNode after: anotherNode | index | index := self indexOfNode: anotherNode. index = 0 ifTrue: [^self addNode: aNode]. statements := (statements asOrderedCollection) add: aNode afterIndex: index; yourself. aNode parent: self! ! !RBSequenceNode methodsFor: 'adding nodes' stamp: ''! addNode: aNode before: anotherNode | index | index := self indexOfNode: anotherNode. index = 0 ifTrue: [^self addNode: aNode]. statements := (statements asOrderedCollection) add: aNode beforeIndex: index; yourself. aNode parent: self! ! !RBSequenceNode methodsFor: 'adding nodes' stamp: ''! addNodeFirst: aNode aNode parent: self. statements := (statements asOrderedCollection) addFirst: aNode; yourself! ! !RBSequenceNode methodsFor: 'adding nodes' stamp: ''! addNodes: aCollection aCollection do: [:each | each parent: self]. (statements isEmpty not and: [statements last isReturn]) ifTrue: [self error: 'Cannot add statement after return node']. statements := (statements asOrderedCollection) addAll: aCollection; yourself! ! !RBSequenceNode methodsFor: 'adding nodes' stamp: 'pmm 9/24/2005 10:52'! addNodes: aCollection after: anotherNode aCollection inject: anotherNode into: [ :node :each | self addNode: each after: node. each ]! ! !RBSequenceNode methodsFor: 'adding nodes' stamp: ''! addNodes: aCollection before: anotherNode aCollection do: [:each | self addNode: each before: anotherNode]! ! !RBSequenceNode methodsFor: 'adding nodes' stamp: ''! addNodesFirst: aCollection aCollection do: [:each | each parent: self]. statements := (statements asOrderedCollection) addAllFirst: aCollection; yourself! ! !RBSequenceNode methodsFor: 'accessing' stamp: ''! addReturn | node | statements isEmpty ifTrue: [^nil]. statements last isReturn ifTrue: [^statements last]. node := RBReturnNode value: statements last. statements at: statements size put: node. node parent: self. ^node! ! !RBSequenceNode methodsFor: 'adding nodes' stamp: ''! addSelfReturn | node | self lastIsReturn ifTrue: [^self]. node := RBReturnNode value: (RBVariableNode named: 'self'). self addNode: node! ! !RBSequenceNode methodsFor: 'adding nodes' stamp: ''! addTemporariesNamed: aCollection aCollection do: [:each | self addTemporaryNamed: each]! ! !RBSequenceNode methodsFor: 'adding nodes' stamp: 'md 4/14/2007 00:59'! addTemporaryNamed: aString | variableNode | variableNode := RBVariableNode named: aString. variableNode parent: self. temporaries := self temporaries copyWith: variableNode! ! !RBSequenceNode methodsFor: 'accessing' stamp: ''! allDefinedVariables ^(self temporaryNames asOrderedCollection) addAll: super allDefinedVariables; yourself! ! !RBSequenceNode methodsFor: 'accessing' stamp: ''! allTemporaryVariables ^(self temporaryNames asOrderedCollection) addAll: super allTemporaryVariables; yourself! ! !RBSequenceNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:35'! basicFirstToken self temporaries ifEmpty: [self statements ifEmpty:[^nil] ifNotEmpty:[| stat | stat := OrderedCollection newFrom: self statements. [stat first firstToken = nil] whileTrue: [stat removeFirst. stat ifEmpty:[^nil]]. ^stat first firstToken]] ifNotEmpty: [^self temporaries first firstToken]! ! !RBSequenceNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:36'! basicLastToken self statements ifEmpty:[self temporaries ifEmpty:[^nil] ifNotEmpty:[^self temporaries last lastToken]] ifNotEmpty:[ | stat | stat := OrderedCollection newFrom: self statements. [stat last lastToken = nil] whileTrue: [stat removeLast. stat ifEmpty:[self temporaries ifEmpty:[^nil] ifNotEmpty:[^self temporaries last lastToken]]]. ^stat last lastToken]! ! !RBSequenceNode methodsFor: 'querying' stamp: 'md 4/14/2007 00:57'! bestNodeFor: anInterval | node | node := super bestNodeFor: anInterval. node == self ifTrue: [(self temporaries isEmpty and: [statements size == 1]) ifTrue: [^statements first]]. ^node! ! !RBSequenceNode methodsFor: 'accessing' stamp: ''! children ^(OrderedCollection new) addAll: self temporaries; addAll: self statements; yourself! ! !RBSequenceNode methodsFor: 'matching' stamp: 'md 4/14/2007 00:59'! copyInContext: aDictionary ^(self class new) temporaries: (self copyList: self temporaries inContext: aDictionary); statements: (self copyList: statements inContext: aDictionary); yourself! ! !RBSequenceNode methodsFor: 'testing' stamp: 'md 4/14/2007 00:58'! defines: aName ^self temporaries anySatisfy: [:each | each name = aName]! ! !RBSequenceNode methodsFor: 'testing' stamp: ''! directlyUses: aNode ^false! ! !RBSequenceNode methodsFor: 'comparing' stamp: 'pmm 7/13/2006 18:38'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. self statements size == anObject statements size ifFalse: [^false]. self statements with: anObject statements do: [ :first :second | (first equalTo: second withMapping: aDictionary) ifFalse: [^false]]. aDictionary values asSet size = aDictionary size ifFalse: [^false]. "Not a one-to-one mapping" self temporaries do: [:each | aDictionary removeKey: each name ifAbsent: []]. ^true! ! !RBSequenceNode methodsFor: 'comparing' stamp: ''! hash ^self temporaries hash bitXor: (self statements isEmpty ifTrue: [0] ifFalse: [self statements first hash])! ! !RBSequenceNode methodsFor: 'private' stamp: ''! indexOfNode: aNode "Try to find the node by first looking for ==, and then for =" ^(1 to: statements size) detect: [:each | (statements at: each) == aNode] ifNone: [statements indexOf: aNode]! ! !RBSequenceNode methodsFor: 'testing' stamp: ''! isLast: aNode | last | statements isEmpty ifTrue: [^false]. last := statements last. ^last == aNode or: [last isMessage and: [(#(#ifTrue:ifFalse: #ifFalse:ifTrue:) includes: last selector) and: [last arguments inject: false into: [:bool :each | bool or: [each isLast: aNode]]]]]! ! !RBSequenceNode methodsFor: 'testing' stamp: ''! isSequence ^true! ! !RBSequenceNode methodsFor: 'testing' stamp: ''! lastIsReturn ^statements isEmpty not and: [statements last lastIsReturn]! ! !RBSequenceNode methodsFor: 'accessing' stamp: 'md 4/7/2007 20:28'! leftBar: anObject anObject ifNil: [^self removeProperty: #leftBar ifAbsent: []]. self propertyAt: #leftBar put: anObject.! ! !RBSequenceNode methodsFor: 'initialize-release' stamp: 'md 4/7/2007 20:28'! leftBar: leftInteger temporaries: variableNodes rightBar: rightInteger self leftBar: leftInteger. variableNodes ifNotEmpty: [self temporaries: variableNodes] ifEmpty: [#()]. self rightBar: rightInteger! ! !RBSequenceNode methodsFor: 'matching' stamp: 'md 4/6/2007 22:49'! match: aNode inContext: aDictionary self class == aNode class ifFalse: [^false]. ^(self matchList: self temporaries against: aNode temporaries inContext: aDictionary) and: [self matchList: statements against: aNode statements inContext: aDictionary]! ! !RBSequenceNode methodsFor: 'accessing' stamp: 'md 4/7/2007 20:19'! periods: anObject anObject ifNil: [^self removeProperty: #periods ifAbsent: []]. self propertyAt: #periods put: anObject.! ! !RBSequenceNode methodsFor: 'copying' stamp: 'md 4/14/2007 00:58'! postCopy super postCopy. temporaries := self temporaries collect: [:each | each copy parent: self; yourself ]. statements := statements collect: [:each | each copy parent: self; yourself ]! ! !RBSequenceNode methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:21'! references: aVariableName ^statements anySatisfy: [:each | each references: aVariableName]! ! !RBSequenceNode methodsFor: 'replacing' stamp: 'md 8/2/2005 22:25'! removeDeadCode (self isUsed ifTrue: [statements size - 1] ifFalse: [statements size]) to: 1 by: -1 do: [:i | (statements at: i) isImmediate ifTrue: [statements removeAt: i]]. super removeDeadCode! ! !RBSequenceNode methodsFor: 'replacing' stamp: ''! removeNode: aNode self replaceNode: aNode withNodes: #()! ! !RBSequenceNode methodsFor: 'accessing' stamp: 'md 4/14/2007 01:00'! removeTemporaryNamed: aName temporaries := temporaries reject: [:each | each name = aName]. temporaries isEmpty ifTrue: [temporaries := nil].! ! !RBSequenceNode methodsFor: 'replacing' stamp: 'md 4/14/2007 00:57'! replaceNode: aNode withNode: anotherNode self statements: (statements collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]]). self temporaries: (self temporaries collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]]). anotherNode parent: self! ! !RBSequenceNode methodsFor: 'replacing' stamp: ''! replaceNode: aNode withNodes: aCollection | index newStatements | index := self indexOfNode: aNode. newStatements := OrderedCollection new: statements size + aCollection size. 1 to: index - 1 do: [:i | newStatements add: (statements at: i)]. newStatements addAll: aCollection. index + 1 to: statements size do: [:i | newStatements add: (statements at: i)]. aCollection do: [:each | each parent: self]. statements := newStatements! ! !RBSequenceNode methodsFor: 'accessing' stamp: 'md 4/7/2007 20:27'! rightBar: anObject anObject ifNil: [^self removeProperty: #rightBar ifAbsent: []]. self propertyAt: #rightBar put: anObject.! ! !RBSequenceNode methodsFor: 'accessing' stamp: 'ms 3/31/2007 20:25'! start ^self firstToken start! ! !RBSequenceNode methodsFor: 'accessing' stamp: ''! statements ^statements! ! !RBSequenceNode methodsFor: 'accessing' stamp: ''! statements: stmtCollection statements := stmtCollection. statements do: [:each | each parent: self]! ! !RBSequenceNode methodsFor: 'accessing' stamp: 'ms 3/31/2007 20:26'! stop ^self lastToken stop! ! !RBSequenceNode methodsFor: 'accessing' stamp: 'md 4/6/2007 14:03'! temporaries ^temporaries ifNil: [#()].! ! !RBSequenceNode methodsFor: 'accessing' stamp: ''! temporaries: tempCollection temporaries := tempCollection. temporaries do: [:each | each parent: self]! ! !RBSequenceNode methodsFor: 'accessing' stamp: 'md 4/8/2007 17:50'! temporaryNames ^self temporaries collect: [:each | each name]! ! !RBSequenceNode methodsFor: 'accessing' stamp: ''! temporaryVariables ^(super temporaryVariables asOrderedCollection) addAll: self temporaryNames; yourself! ! !RBSequenceNode methodsFor: 'testing' stamp: ''! uses: aNode statements isEmpty ifTrue: [^false]. aNode == statements last ifFalse: [^false]. ^self isUsed! ! !RBSequenceNode methodsFor: 'querying' stamp: 'md 4/14/2007 00:57'! whichNodeIsContainedBy: anInterval | node | node := super whichNodeIsContainedBy: anInterval. node == self ifTrue: [(self temporaries isEmpty and: [statements size == 1]) ifTrue: [^statements first]]. ^node! ! RBProgramNode subclass: #RBValueNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBValueNode commentStamp: 'md 8/9/2005 14:59' prior: 0! RBValueNode is an abstract class that represents a node that returns some value. Subclasses must implement the following messages: accessing startWithoutParentheses stopWithoutParentheses testing needsParenthesis Instance Variables: parentheses the positions of the parethesis around this node. We need a collection of intervals for stupid code such as "((3 + 4))" that has multiple parethesis around the same expression. ! RBValueNode subclass: #RBArrayNode instanceVariableNames: 'statements' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBArrayNode class methodsFor: 'instance creation' stamp: 'ls 1/23/2000 23:56'! leftBrace: leftBrace rightBrace: rightBrace statements: statements ^self new leftBrace: leftBrace rightBrace: rightBrace statements: statements! ! !RBArrayNode class methodsFor: 'instance creation' stamp: 'ajh 3/4/2003 02:03'! statements: statements ^ self new statements: statements! ! !RBArrayNode methodsFor: 'comparing' stamp: 'bh 4/3/2000 12:46'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. ^statements = anObject statements.! ! !RBArrayNode methodsFor: 'visitor' stamp: 'ajh 3/17/2003 00:25'! acceptVisitor: aProgramNodeVisitor ^ aProgramNodeVisitor acceptArrayNode: self! ! !RBArrayNode methodsFor: 'replacing' stamp: 'md 4/7/2007 21:03'! adjustPositionsAfter: sourcePos by: delta "Slide token positions after sourcePos by delta" self leftBrace: self leftBrace + delta. self rightBrace: self rightBrace + delta. super adjustPositionsAfter: sourcePos by: delta. ! ! !RBArrayNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:36'! basicFirstToken self statements ifEmpty:[^nil] ifNotEmpty:[| stat | stat := self statements copy. [stat first firstToken = nil] whileTrue: [stat removeFirst. stat ifEmpty:[^nil]]. ^stat first firstToken]! ! !RBArrayNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:37'! basicLastToken self statements ifEmpty:[^nil] ifNotEmpty:[ | stat | stat := OrderedCollection newFrom: self statements. [stat last lastToken = nil] whileTrue: [stat removeLast. stat ifEmpty:[^nil]]. ^stat last lastToken]! ! !RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/24/2000 00:00'! children ^statements! ! !RBArrayNode methodsFor: 'comparing' stamp: 'bh 4/3/2000 12:46'! hash ^statements hash.! ! !RBArrayNode methodsFor: 'testing' stamp: 'ajh 2/25/2003 14:34'! isArray ^ true! ! !RBArrayNode methodsFor: 'testing' stamp: 'ls 1/24/2000 00:28'! lastIsReturn statements isEmpty ifTrue:[ ^false ]. ^statements last lastIsReturn! ! !RBArrayNode methodsFor: 'accessing' stamp: 'md 4/7/2007 21:07'! leftBrace ^ self propertyAt: #leftBrace ifAbsent: [nil].! ! !RBArrayNode methodsFor: 'accessing' stamp: 'md 4/7/2007 21:07'! leftBrace: leftBrace0 leftBrace0 ifNil: [^self removeProperty: #leftBrace ifAbsent: []]. self propertyAt: #leftBrace put: leftBrace0.! ! !RBArrayNode methodsFor: 'initialization' stamp: 'ajh 3/4/2003 02:04'! leftBrace: leftBrace0 rightBrace: rightBrace0 statements: statements0 self leftBrace: leftBrace0. self rightBrace: rightBrace0. self statements: statements0.! ! !RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/24/2000 00:02'! periods: periods "ignored"! ! !RBArrayNode methodsFor: 'copying' stamp: 'pmm 2/24/2006 11:00'! postCopy super postCopy. statements := statements collect: [ :statement | statement copy parent: self; yourself ]! ! !RBArrayNode methodsFor: 'accessing' stamp: 'nk 3/3/2005 09:47'! precedence ^0! ! !RBArrayNode methodsFor: 'replacing' stamp: 'ls 1/24/2000 00:27'! replaceNode: oldNode withNode: newNode statements := statements collect: [ :statement | statement == oldNode ifTrue: [ newNode ] ifFalse: [ statement ] ]! ! !RBArrayNode methodsFor: 'accessing' stamp: 'md 4/7/2007 21:05'! rightBrace ^ self propertyAt: #rightBrace ifAbsent: [nil].! ! !RBArrayNode methodsFor: 'accessing' stamp: 'md 4/7/2007 21:06'! rightBrace: rightBrace0 rightBrace0 ifNil: [^self removeProperty: #rightBrace ifAbsent: []]. self propertyAt: #rightBrace put: rightBrace0.! ! !RBArrayNode methodsFor: 'accessing' stamp: 'md 4/7/2007 21:04'! start ^self leftBrace! ! !RBArrayNode methodsFor: 'accessing' stamp: 'md 4/7/2007 21:04'! startWithoutParentheses ^ self leftBrace! ! !RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/24/2000 00:32'! statements ^statements! ! !RBArrayNode methodsFor: 'accessing' stamp: 'dvf 11/12/2002 00:47'! statements: statements0 statements ifNotNil: [self error: 'double initialization']. statements := statements0. statements do: [:statement | statement parent: self]! ! !RBArrayNode methodsFor: 'accessing' stamp: 'md 4/7/2007 21:03'! stop ^self rightBrace! ! !RBArrayNode methodsFor: 'accessing' stamp: 'md 4/7/2007 21:03'! stopWithoutParentheses ^ self rightBrace! ! RBValueNode subclass: #RBAssignmentNode instanceVariableNames: 'variable assignment value' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBAssignmentNode commentStamp: 'md 4/14/2007 00:26' prior: 0! RBAssignmentNode is an AST node for assignment statements Instance Variables: value the value that we're assigning variable the variable being assigned assignment position of the := ! !RBAssignmentNode class methodsFor: 'instance creation' stamp: ''! variable: aVariableNode value: aValueNode ^self variable: aVariableNode value: aValueNode position: nil! ! !RBAssignmentNode class methodsFor: 'instance creation' stamp: ''! variable: aVariableNode value: aValueNode position: anInteger ^self new variable: aVariableNode value: aValueNode position: anInteger! ! !RBAssignmentNode methodsFor: 'comparing' stamp: ''! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. ^self variable = anObject variable and: [self value = anObject value]! ! !RBAssignmentNode methodsFor: 'visitor' stamp: ''! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptAssignmentNode: self! ! !RBAssignmentNode methodsFor: 'testing' stamp: ''! assigns: aVariableName ^variable name = aVariableName or: [value assigns: aVariableName]! ! !RBAssignmentNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:38'! basicFirstToken ^self variable firstToken! ! !RBAssignmentNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:38'! basicLastToken ^self value lastToken! ! !RBAssignmentNode methodsFor: 'querying' stamp: ''! bestNodeFor: anInterval (self intersectsInterval: anInterval) ifFalse: [^nil]. (self containedBy: anInterval) ifTrue: [^self]. assignment isNil ifTrue: [^super bestNodeFor: anInterval]. ((anInterval first between: assignment and: assignment + 1) or: [assignment between: anInterval first and: anInterval last]) ifTrue: [^self]. self children do: [:each | | node | node := each bestNodeFor: anInterval. node notNil ifTrue: [^node]]! ! !RBAssignmentNode methodsFor: 'accessing' stamp: ''! children ^Array with: value with: variable! ! !RBAssignmentNode methodsFor: 'matching' stamp: ''! copyInContext: aDictionary ^(self class new) variable: (variable copyInContext: aDictionary); value: (value copyInContext: aDictionary); yourself! ! !RBAssignmentNode methodsFor: 'testing' stamp: ''! directlyUses: aNode ^aNode = value ifTrue: [true] ifFalse: [self isDirectlyUsed]! ! !RBAssignmentNode methodsFor: 'comparing' stamp: ''! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. ^(self variable equalTo: anObject variable withMapping: aDictionary) and: [self value equalTo: anObject value withMapping: aDictionary]! ! !RBAssignmentNode methodsFor: 'comparing' stamp: ''! hash ^self variable hash bitXor: self value hash! ! !RBAssignmentNode methodsFor: 'testing' stamp: ''! isAssignment ^true! ! !RBAssignmentNode methodsFor: 'matching' stamp: ''! match: aNode inContext: aDictionary aNode class == self class ifFalse: [^false]. ^(variable match: aNode variable inContext: aDictionary) and: [value match: aNode value inContext: aDictionary]! ! !RBAssignmentNode methodsFor: 'copying' stamp: 'pmm 2/24/2006 11:00'! postCopy super postCopy. variable := variable copy. variable parent: self. value := value copy. value parent: self! ! !RBAssignmentNode methodsFor: 'accessing' stamp: ''! precedence ^5! ! !RBAssignmentNode methodsFor: 'replacing' stamp: ''! replaceNode: aNode withNode: anotherNode value == aNode ifTrue: [self value: anotherNode]. variable == aNode ifTrue: [self variable: anotherNode]! ! !RBAssignmentNode methodsFor: 'accessing' stamp: ''! startWithoutParentheses ^variable start! ! !RBAssignmentNode methodsFor: 'accessing' stamp: ''! stopWithoutParentheses ^value stop! ! !RBAssignmentNode methodsFor: 'testing' stamp: ''! uses: aNode ^aNode = value ifTrue: [true] ifFalse: [self isUsed]! ! !RBAssignmentNode methodsFor: 'accessing' stamp: ''! value ^value! ! !RBAssignmentNode methodsFor: 'accessing' stamp: ''! value: aValueNode value := aValueNode. value parent: self! ! !RBAssignmentNode methodsFor: 'accessing' stamp: ''! variable ^variable! ! !RBAssignmentNode methodsFor: 'accessing' stamp: ''! variable: varNode variable := varNode. variable parent: self! ! !RBAssignmentNode methodsFor: 'initialize-release' stamp: ''! variable: aVariableNode value: aValueNode position: anInteger self variable: aVariableNode. self value: aValueNode. assignment := anInteger! ! RBValueNode subclass: #RBBlockNode instanceVariableNames: 'body arguments' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBBlockNode commentStamp: 'md 4/7/2007 21:09' prior: 0! RBBlockNode is an AST node that represents a block "[...]". Instance Variables: arguments the arguments for the block body the code inside the block Properties: bar position of the | after the arguments colons positions of each : before each argument left position of [ right position of ] ! !RBBlockNode class methodsFor: 'instance creation' stamp: ''! arguments: argNodes body: sequenceNode ^(self new) arguments: argNodes; body: sequenceNode; yourself! ! !RBBlockNode class methodsFor: 'instance creation' stamp: ''! body: sequenceNode ^self arguments: #() body: sequenceNode! ! !RBBlockNode methodsFor: 'comparing' stamp: 'pmm 7/12/2006 15:39'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. self body = anObject body ifFalse: [^false]. ^self arguments = anObject arguments! ! !RBBlockNode methodsFor: 'visitor' stamp: ''! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptBlockNode: self! ! !RBBlockNode methodsFor: 'replacing' stamp: 'md 4/7/2007 20:20'! adjustPositionsAfter: sourcePos by: delta "Slide token positions after sourcePos by delta" self left: self left + delta. self right: self right + delta. super adjustPositionsAfter: sourcePos by: delta. ! ! !RBBlockNode methodsFor: 'accessing' stamp: ''! allArgumentVariables ^(self argumentNames asOrderedCollection) addAll: super allArgumentVariables; yourself! ! !RBBlockNode methodsFor: 'accessing' stamp: ''! allDefinedVariables ^(self argumentNames asOrderedCollection) addAll: super allDefinedVariables; yourself! ! !RBBlockNode methodsFor: 'accessing' stamp: ''! argumentNames ^self arguments collect: [:each | each name]! ! !RBBlockNode methodsFor: 'accessing' stamp: ''! arguments ^arguments! ! !RBBlockNode methodsFor: 'accessing' stamp: ''! arguments: argCollection arguments := argCollection. arguments do: [:each | each parent: self]! ! !RBBlockNode methodsFor: 'accessing' stamp: 'md 4/7/2007 15:55'! bar ^ self propertyAt: #bar ifAbsent: [nil].! ! !RBBlockNode methodsFor: 'accessing' stamp: 'md 4/7/2007 15:55'! bar: anObject anObject ifNil: [^self removeProperty: #bar ifAbsent: []]. self propertyAt: #bar put: anObject.! ! !RBBlockNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:39'! basicFirstToken self arguments ifEmpty: [^self body firstToken] ifNotEmpty: [^self arguments first firstToken]! ! !RBBlockNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:39'! basicLastToken ^self body lastToken ifNil:[ self arguments ifEmpty:[^nil] ifNotEmpty:[^self arguments last firstToken]]! ! !RBBlockNode methodsFor: 'accessing' stamp: ''! blockVariables | vars | vars := super blockVariables asOrderedCollection. vars addAll: self argumentNames. ^vars! ! !RBBlockNode methodsFor: 'accessing' stamp: ''! body ^body! ! !RBBlockNode methodsFor: 'accessing' stamp: ''! body: stmtsNode body := stmtsNode. body parent: self! ! !RBBlockNode methodsFor: 'accessing' stamp: ''! children ^self arguments copyWith: self body! ! !RBBlockNode methodsFor: 'accessing' stamp: 'md 4/7/2007 20:21'! colons: anObject anObject ifNil: [^self removeProperty: #colons ifAbsent: []]. self propertyAt: #colons put: anObject.! ! !RBBlockNode methodsFor: 'matching' stamp: ''! copyInContext: aDictionary ^(self class new) arguments: (self copyList: arguments inContext: aDictionary); body: (body copyInContext: aDictionary); yourself! ! !RBBlockNode methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:17'! defines: aName ^arguments anySatisfy: [:each | each name = aName]! ! !RBBlockNode methodsFor: 'testing' stamp: ''! directlyUses: aNode ^false! ! !RBBlockNode methodsFor: 'comparing' stamp: 'pmm 7/12/2006 15:39'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. self arguments size = anObject arguments size ifFalse: [^false]. self arguments with: anObject arguments do: [ :first :second | (first equalTo: second withMapping: aDictionary) ifFalse: [^false]]. (self body equalTo: anObject body withMapping: aDictionary) ifFalse: [^false]. self arguments do: [:each | aDictionary removeKey: each name]. ^true! ! !RBBlockNode methodsFor: 'semantics' stamp: 'ajh 7/8/2004 20:56'! freeNames "Filter out hidden ones that have space in there name such as 'top env'" ^ ((self freeVars collect: [:var | var name]) reject: [:name | name includes: $ ]) asSortedCollection! ! !RBBlockNode methodsFor: 'semantics' stamp: 'md 4/3/2007 13:43'! freeVars "Return children variable node bindings that refer to variables outside my scope (ignoring global vars)" | freeVars | freeVars := Set new. self scope: self owningScope. self nodesDo: [:node | | var | (node isVariable or: [node isReturn and: [node binding notNil]]) ifTrue: [ var := node binding. (self scope hasOuter: var scope) ifTrue: [ var isGlobal ifFalse: [ freeVars add: var]]]]. ^ freeVars! ! !RBBlockNode methodsFor: 'comparing' stamp: ''! hash ^self arguments hash bitXor: self body hash! ! !RBBlockNode methodsFor: 'testing' stamp: ''! isBlock ^true! ! !RBBlockNode methodsFor: 'testing' stamp: ''! isImmediate ^true! ! !RBBlockNode methodsFor: 'inline' stamp: 'ajh 3/13/2003 02:43'! isInlined (parent isMessage and: [parent isInlineAndOr]) ifTrue: [^ true]. (parent isMessage and: [parent isInlineIf]) ifTrue: [^ true]. (parent isMessage and: [parent isInlineIfNil]) ifTrue: [^ true]. (parent isMessage and: [parent isInlineToDo]) ifTrue: [^ true]. (parent isMessage and: [parent isInlineWhile]) ifTrue: [^ true]. (parent isMessage and: [parent parent isArray and: [parent parent parent isMessage and: [parent parent parent isInlineCase]]]) ifTrue: [^ true]. (parent isMessage and: [parent isInlineCase]) ifTrue: [^ true]. "otherwise branch" ^ false! ! !RBBlockNode methodsFor: 'testing' stamp: ''! isLast: aNode ^body isLast: aNode! ! !RBBlockNode methodsFor: 'accessing' stamp: 'md 4/7/2007 20:33'! left ^ self propertyAt: #left ifAbsent: [nil].! ! !RBBlockNode methodsFor: 'accessing' stamp: 'md 4/7/2007 20:33'! left: anObject anObject ifNil: [^self removeProperty: #left ifAbsent: []]. self propertyAt: #left put: anObject.! ! !RBBlockNode methodsFor: 'matching' stamp: ''! match: aNode inContext: aDictionary aNode class == self class ifFalse: [^false]. ^(self matchList: arguments against: aNode arguments inContext: aDictionary) and: [body match: aNode body inContext: aDictionary]! ! !RBBlockNode methodsFor: 'semantics' stamp: 'ajh 6/30/2004 14:07'! owningBlock ^ self! ! !RBBlockNode methodsFor: 'semantics' stamp: 'md 4/3/2007 13:44'! owningScope ^ self scope ifNil: ["inlined" ^ parent owningScope]! ! !RBBlockNode methodsFor: 'copying' stamp: 'pmm 9/19/2005 11:32'! postCopy super postCopy. arguments := arguments collect: [:each | each copy parent: self; yourself ]. body := body copy. body parent: self.! ! !RBBlockNode methodsFor: 'accessing' stamp: ''! precedence ^0! ! !RBBlockNode methodsFor: 'testing' stamp: ''! references: aVariableName ^body references: aVariableName! ! !RBBlockNode methodsFor: 'replacing' stamp: ''! replaceNode: aNode withNode: anotherNode body == aNode ifTrue: [self body: anotherNode]. self arguments: (arguments collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! ! !RBBlockNode methodsFor: 'accessing' stamp: 'md 4/7/2007 20:32'! right ^ self propertyAt: #right ifAbsent: [nil].! ! !RBBlockNode methodsFor: 'accessing' stamp: 'md 4/7/2007 20:33'! right: anObject anObject ifNil: [^self removeProperty: #right ifAbsent: []]. self propertyAt: #right put: anObject.! ! !RBBlockNode methodsFor: 'semantics' stamp: 'md 4/3/2007 13:44'! scope ^ self propertyAt: #scope ifAbsent: [nil].! ! !RBBlockNode methodsFor: 'semantics' stamp: 'md 4/3/2007 13:44'! scope: aSemClosureScope aSemClosureScope ifNil: [^self removeProperty: #scope ifAbsent: []]. self propertyAt: #scope put: aSemClosureScope.! ! !RBBlockNode methodsFor: 'debugging' stamp: 'ajh 2/28/2003 00:18'! sourceMap "Return a mapping from bytecode pcs to source code ranges" ^ self ir sourceMap! ! !RBBlockNode methodsFor: 'printing' stamp: 'ajh 3/17/2003 09:12'! sourceText | text | self parent ifNil: [^ self formattedCode asText]. text := [self root sourceText] on: Error do: [^ self formattedCode asText]. text addAttribute: TextColor gray from: 1 to: self start - 1. text addAttribute: TextColor gray from: self stop + 1 to: text size. ^ text! ! !RBBlockNode methodsFor: 'accessing' stamp: 'md 4/7/2007 20:20'! startWithoutParentheses ^self left! ! !RBBlockNode methodsFor: 'accessing' stamp: 'md 4/7/2007 20:20'! stopWithoutParentheses ^self right! ! !RBBlockNode methodsFor: 'debugging' stamp: 'md 4/6/2007 11:06'! tempNames "All temp names in context order" ^self scope isNil ifFalse: [ self scope tempVars allButFirst "without self" collect: [:var | var name] ] ifTrue: [ #() ]! ! !RBBlockNode methodsFor: 'testing' stamp: ''! uses: aNode aNode = body ifFalse: [^false]. ^parent isMessage ifTrue: [(#(#ifTrue:ifFalse: #ifTrue: #ifFalse: #ifFalse:ifTrue:) includes: parent selector) not or: [parent isUsed]] ifFalse: [self isUsed]! ! RBBlockNode subclass: #RBPatternBlockNode instanceVariableNames: 'valueBlock' classVariableNames: '' poolDictionaries: '' category: 'AST-ParseTree Matching'! !RBPatternBlockNode commentStamp: 'md 8/9/2005 14:56' prior: 0! RBPatternBlockNode is the node in matching parse trees (it never occurs in normal Smalltalk code) that executes a block to determine if a match occurs. valueBlock takes two arguments, the first is the actual node that we are trying to match against, and second node is the dictionary that contains all the metavariable bindings that the matcher has made thus far. Instance Variables: valueBlock The block to execute when attempting to match this to a node. ! !RBPatternBlockNode methodsFor: 'matching' stamp: ''! addArgumentWithNameBasedOn: aString | name index vars | name := aString. vars := self allDefinedVariables. index := 0. [vars includes: name] whileTrue: [index := index + 1. name := name , index printString]. arguments := arguments copyWith: (RBVariableNode named: name)! ! !RBPatternBlockNode methodsFor: 'matching' stamp: ''! copyInContext: aDictionary ^self replacingBlock value: aDictionary! ! !RBPatternBlockNode methodsFor: 'matching' stamp: 'nk 2/26/2005 11:05'! createBlock | source | source := self formattedCode. ^Compiler evaluate: source for: self logged: false! ! !RBPatternBlockNode methodsFor: 'matching' stamp: 'pmm 7/12/2006 15:25'! createMatchingBlock self arguments size > 2 ifTrue: [self error: 'Search blocks can only contain arguments for the node and matching dictionary']. self arguments isEmpty ifTrue: [self error: 'Search blocks must contain one argument for the node']. self arguments size = 1 ifTrue: [self addArgumentWithNameBasedOn: 'aDictionary']. ^self createBlock! ! !RBPatternBlockNode methodsFor: 'matching' stamp: 'pmm 7/12/2006 15:25'! createReplacingBlock self arguments size > 1 ifTrue: [self error: 'Replace blocks can only contain an argument for the matching dictionary']. self arguments isEmpty ifTrue: [self addArgumentWithNameBasedOn: 'aDictionary']. ^self createBlock! ! !RBPatternBlockNode methodsFor: 'matching' stamp: ''! match: aNode inContext: aDictionary ^self matchingBlock value: aNode value: aDictionary! ! !RBPatternBlockNode methodsFor: 'matching' stamp: ''! matchingBlock ^valueBlock isNil ifTrue: [valueBlock := self createMatchingBlock] ifFalse: [valueBlock]! ! !RBPatternBlockNode methodsFor: 'matching' stamp: ''! replacingBlock ^valueBlock isNil ifTrue: [valueBlock := self createReplacingBlock] ifFalse: [valueBlock]! ! !RBPatternBlockNode methodsFor: 'accessing' stamp: ''! sentMessages ^OrderedCollection new! ! RBValueNode subclass: #RBCascadeNode instanceVariableNames: 'messages' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBCascadeNode commentStamp: 'md 4/7/2007 12:56' prior: 0! RBCascadeNode is an AST node for cascaded messages (e.g., "self print1 ; print2"). Instance Variables: messages the messages Properties: #semicolons positions of the ; between messages ! !RBCascadeNode class methodsFor: 'instance creation' stamp: ''! messages: messageNodes ^self new messages: messageNodes! ! !RBCascadeNode class methodsFor: 'instance creation' stamp: ''! messages: messageNodes semicolons: integerCollection ^self new messages: messageNodes semicolons: integerCollection! ! !RBCascadeNode methodsFor: 'comparing' stamp: 'pmm 7/12/2006 15:58'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. ^self messages = anObject messages! ! !RBCascadeNode methodsFor: 'visitor' stamp: ''! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptCascadeNode: self! ! !RBCascadeNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:39'! basicFirstToken ^self messages first firstToken! ! !RBCascadeNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:39'! basicLastToken ^self messages last lastToken! ! !RBCascadeNode methodsFor: 'querying' stamp: ''! bestNodeFor: anInterval | selectedChildren | (self intersectsInterval: anInterval) ifFalse: [^nil]. (self containedBy: anInterval) ifTrue: [^self]. messages reverseDo: [:each | (each containedBy: anInterval) ifTrue: [^each]]. selectedChildren := (messages collect: [:each | each bestNodeFor: anInterval]) reject: [:each | each isNil]. ^selectedChildren detect: [:each | true] ifNone: [nil]! ! !RBCascadeNode methodsFor: 'accessing' stamp: ''! children ^self messages! ! !RBCascadeNode methodsFor: 'matching' stamp: ''! copyInContext: aDictionary ^(self class new) messages: (self copyList: messages inContext: aDictionary); yourself! ! !RBCascadeNode methodsFor: 'testing' stamp: ''! directlyUses: aNode ^messages last = aNode and: [self isDirectlyUsed]! ! !RBCascadeNode methodsFor: 'comparing' stamp: 'pmm 7/13/2006 18:38'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. self messages size == anObject messages size ifFalse: [^false]. self messages with: anObject messages do: [ :first :second | (first equalTo: second withMapping: aDictionary) ifFalse: [^false]]. ^true! ! !RBCascadeNode methodsFor: 'comparing' stamp: 'bh 4/10/2001 15:59'! hash ^self messages asArray hash! ! !RBCascadeNode methodsFor: 'testing' stamp: ''! isCascade ^true! ! !RBCascadeNode methodsFor: 'matching' stamp: ''! match: aNode inContext: aDictionary aNode class == self class ifFalse: [^false]. ^self matchList: messages against: aNode messages inContext: aDictionary! ! !RBCascadeNode methodsFor: 'accessing' stamp: ''! messages ^messages! ! !RBCascadeNode methodsFor: 'accessing' stamp: ''! messages: messageNodeCollection messages := messageNodeCollection. messages do: [:each | each parent: self]! ! !RBCascadeNode methodsFor: 'initialize-release' stamp: 'md 4/7/2007 12:55'! messages: messageNodes semicolons: integerCollection self messages: messageNodes. self propertyAt: #semicolons put: integerCollection! ! !RBCascadeNode methodsFor: 'copying' stamp: 'pmm 9/19/2005 11:32'! postCopy super postCopy. messages := messages collect: [:each | each copy parent: self; yourself ]! ! !RBCascadeNode methodsFor: 'accessing' stamp: ''! precedence ^4! ! !RBCascadeNode methodsFor: 'accessing' stamp: 'ajh 2/25/2003 01:12'! receiver ^ self messages first receiver! ! !RBCascadeNode methodsFor: 'replacing' stamp: ''! replaceNode: aNode withNode: anotherNode self messages: (messages collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! ! !RBCascadeNode methodsFor: 'accessing' stamp: ''! startWithoutParentheses ^messages first start! ! !RBCascadeNode methodsFor: 'accessing' stamp: ''! stopWithoutParentheses ^messages last stop! ! !RBCascadeNode methodsFor: 'testing' stamp: ''! uses: aNode ^messages last = aNode and: [self isUsed]! ! !RBCascadeNode methodsFor: 'querying' stamp: ''! whichNodeIsContainedBy: anInterval | selectedChildren | (self intersectsInterval: anInterval) ifFalse: [^nil]. (self containedBy: anInterval) ifTrue: [^self]. messages reverseDo: [:each | (each containedBy: anInterval) ifTrue: [^each]]. selectedChildren := (messages collect: [:each | each whichNodeIsContainedBy: anInterval]) reject: [:each | each isNil]. ^selectedChildren detect: [:each | true] ifNone: [nil]! ! RBValueNode subclass: #RBLiteralNode instanceVariableNames: 'token value' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBLiteralNode commentStamp: 'md 8/9/2005 14:58' prior: 0! RBLiteralNode is an AST node that represents literals (e.g., #foo, #(1 2 3), true, etc.). Instance Variables: token the token that contains the literal value as well as its source positions ! !RBLiteralNode class methodsFor: 'instance creation' stamp: ''! literalToken: aLiteralToken ^self new literalToken: aLiteralToken! ! !RBLiteralNode class methodsFor: 'instance creation' stamp: 'ajh 2/27/2003 17:22'! literalToken: aLiteralToken value: object ^self new literalToken: aLiteralToken; value: object! ! !RBLiteralNode class methodsFor: 'instance creation' stamp: ''! value: aValue ^self literalToken: (RBLiteralToken value: aValue)! ! !RBLiteralNode methodsFor: 'comparing' stamp: ''! = anObject self == anObject ifTrue: [^true]. self class == anObject class ifFalse: [^false]. self value class == anObject value class ifFalse: [^false]. ^self value = anObject value! ! !RBLiteralNode methodsFor: 'visitor' stamp: ''! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptLiteralNode: self! ! !RBLiteralNode methodsFor: 'replacing' stamp: 'ajh 3/13/2003 16:11'! adjustPositionsAfter: sourcePos by: delta "Slide token positions after sourcePos by delta" token start > sourcePos ifTrue: [ token start: token start + delta]! ! !RBLiteralNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:40'! basicFirstToken ^self token! ! !RBLiteralNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:40'! basicLastToken ^self token! ! !RBLiteralNode methodsFor: 'matching' stamp: ''! copyInContext: aDictionary ^self class literalToken: token removePositions! ! !RBLiteralNode methodsFor: 'comparing' stamp: ''! hash ^self value hash! ! !RBLiteralNode methodsFor: 'testing' stamp: ''! isImmediate ^true! ! !RBLiteralNode methodsFor: 'testing' stamp: ''! isLiteral ^true! ! !RBLiteralNode methodsFor: 'testing' stamp: 'ajh 3/3/2003 22:29'! isLiteral: valueTestBlock ^ valueTestBlock value: self value! ! !RBLiteralNode methodsFor: 'initialize-release' stamp: ''! literalToken: aLiteralToken token := aLiteralToken! ! !RBLiteralNode methodsFor: 'accessing' stamp: ''! precedence ^0! ! !RBLiteralNode methodsFor: 'accessing' stamp: 'ms 3/31/2007 20:41'! startWithoutParentheses ^self firstToken start! ! !RBLiteralNode methodsFor: 'accessing' stamp: 'ms 3/31/2007 20:42'! stopWithoutParentheses ^self lastToken stop! ! !RBLiteralNode methodsFor: 'accessing' stamp: ''! token ^token! ! !RBLiteralNode methodsFor: 'accessing' stamp: 'md 4/13/2007 22:44'! value ^ (token notNil and: [token isRBToken]) ifTrue: [token realValue] ifFalse: [value]! ! !RBLiteralNode methodsFor: 'initialize-release' stamp: 'ajh 2/27/2003 17:22'! value: object value := object! ! RBValueNode subclass: #RBMessageNode instanceVariableNames: 'receiver selector selectorParts arguments' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBMessageNode commentStamp: 'md 8/9/2005 14:58' prior: 0! RBMessageNode is an AST node that represents a message send. Instance Variables: arguments our argument nodes receiver the receiver's node selector the selector we're sending (cached) selectorParts the tokens for each keyword ! !RBMessageNode class methodsFor: 'instance creation' stamp: ''! receiver: aValueNode selector: aSymbol ^self receiver: aValueNode selector: aSymbol arguments: #()! ! !RBMessageNode class methodsFor: 'instance creation' stamp: ''! receiver: aValueNode selector: aSymbol arguments: valueNodes ^(self new) receiver: aValueNode; arguments: valueNodes; selector: aSymbol; yourself! ! !RBMessageNode class methodsFor: 'instance creation' stamp: 'pmm 7/12/2006 15:18'! receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes ^((keywordTokens anySatisfy: [:each | each isPatternVariable]) ifTrue: [RBPatternMessageNode] ifFalse: [RBMessageNode]) new receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes! ! !RBMessageNode methodsFor: 'comparing' stamp: 'pmm 7/12/2006 15:40'! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. (self receiver = anObject receiver and: [self selector = anObject selector]) ifFalse: [^false]. ^self arguments = anObject arguments! ! !RBMessageNode methodsFor: 'visitor' stamp: ''! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptMessageNode: self! ! !RBMessageNode methodsFor: 'replacing' stamp: 'ajh 3/13/2003 16:12'! adjustPositionsAfter: sourcePos by: delta "Slide token positions after sourcePos by delta" selectorParts do: [:token | token start > sourcePos ifTrue: [ token start: token start + delta] ]. super adjustPositionsAfter: sourcePos by: delta. ! ! !RBMessageNode methodsFor: 'accessing' stamp: 'md 4/8/2007 17:52'! arguments ^arguments ifNil: [#()]! ! !RBMessageNode methodsFor: 'accessing' stamp: 'md 4/6/2007 11:12'! arguments: argCollection arguments := argCollection. arguments isEmptyOrNil ifTrue: [arguments := nil. ^self]. arguments do: [:each | each parent: self]! ! !RBMessageNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:44'! basicFirstToken ^self receiver firstToken! ! !RBMessageNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:44'! basicLastToken self arguments ifEmpty:[^self selectorParts last] ifNotEmpty: [^self arguments last lastToken]! ! !RBMessageNode methodsFor: 'querying' stamp: ''! bestNodeFor: anInterval (self intersectsInterval: anInterval) ifFalse: [^nil]. (self containedBy: anInterval) ifTrue: [^self]. selectorParts do: [:each | ((anInterval first between: each start and: each stop) or: [each start between: anInterval first and: anInterval last]) ifTrue: [^self]]. self children do: [:each | | node | node := each bestNodeFor: anInterval. node notNil ifTrue: [^node]]! ! !RBMessageNode methodsFor: 'private' stamp: ''! buildSelector | selectorStream | selectorStream := WriteStream on: (String new: 50). selectorParts do: [:each | selectorStream nextPutAll: each value]. ^selectorStream contents asSymbol! ! !RBMessageNode methodsFor: 'replacing' stamp: 'ajh 3/17/2003 13:11'! changeSelectorParts: tokenCollection | root oldToken newToken | root := self root. 1 to: selectorParts size do: [:i | oldToken := selectorParts at: i. newToken := tokenCollection at: i. root adjustPositionsAfter: oldToken stop by: newToken stop - oldToken stop. selectorParts at: i put: newToken. ]. selector := nil. ! ! !RBMessageNode methodsFor: 'accessing' stamp: ''! children ^(OrderedCollection with: self receiver) addAll: self arguments; yourself! ! !RBMessageNode methodsFor: 'matching' stamp: 'md 4/6/2007 11:13'! copyInContext: aDictionary ^(self class new) receiver: (receiver copyInContext: aDictionary); selectorParts: (selectorParts collect: [:each | each removePositions]); arguments: (self arguments collect: [:each | each copyInContext: aDictionary]); yourself! ! !RBMessageNode methodsFor: 'accessing' stamp: 'ajh 3/15/2003 15:18'! debugHighlightStart ^ self selectorParts first start! ! !RBMessageNode methodsFor: 'accessing' stamp: 'ajh 3/15/2003 15:19'! debugHighlightStop ^ self stopWithoutParentheses! ! !RBMessageNode methodsFor: 'comparing' stamp: 'pmm 7/12/2006 15:40'! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. ((self receiver equalTo: anObject receiver withMapping: aDictionary) and: [self selector = anObject selector]) ifFalse: [^false]. self arguments with: anObject arguments do: [ :first :second | (first equalTo: second withMapping: aDictionary) ifFalse: [^false]]. ^true! ! !RBMessageNode methodsFor: 'comparing' stamp: ''! hash ^(self receiver hash bitXor: self selector hash) bitXor: (self arguments isEmpty ifTrue: [0] ifFalse: [self arguments first hash])! ! !RBMessageNode methodsFor: 'testing' stamp: ''! isBinary ^(self isUnary or: [self isKeyword]) not! ! !RBMessageNode methodsFor: 'testing' stamp: ''! isCascaded ^parent notNil and: [parent isCascade]! ! !RBMessageNode methodsFor: 'testing' stamp: ''! isFirstCascaded ^self isCascaded and: [parent messages first == self]! ! !RBMessageNode methodsFor: 'inline' stamp: 'ajh 2/25/2003 19:47'! isInline self isInlineAndOr ifTrue: [^ true]. self isInlineCase ifTrue: [^ true]. self isInlineIf ifTrue: [^ true]. self isInlineIfNil ifTrue: [^ true]. self isInlineToDo ifTrue: [^ true]. self isInlineWhile ifTrue: [^ true]. ^ false! ! !RBMessageNode methodsFor: 'inline' stamp: 'pmm 7/24/2006 21:57'! isInlineAndOr self receiver isBlock ifTrue: [^ false]. self isCascaded ifTrue: [^ false]. (self selectorParts allSatisfy: [ :each | | value | value := each isRBToken ifTrue: [each realValue] ifFalse: [each value]. #(and: or:) includes: value ]) ifFalse: [^ false]. (self arguments allSatisfy: [ :each | each isBlock ]) ifFalse: [^ false]. (self arguments allSatisfy: [ :each | each arguments isEmpty ]) ifFalse: [ self notify: 'and: (or:) takes zero-arg block'. ^ false ]. ^ true! ! !RBMessageNode methodsFor: 'inline' stamp: 'md 4/14/2007 00:39'! isInlineCase self isCascaded ifTrue: [^ false]. (#(caseOf: caseOf:otherwise:) includes: self selector) ifFalse: [^ false]. self arguments size = 2 ifTrue: [ "otherwise block" self arguments last isBlock ifFalse: [^ false]]. self arguments first isArray ifFalse: [^ false]. self arguments first statements do: [:assoc | (assoc isMessage and: [assoc selector == #->]) ifFalse: [^ false]. assoc receiver isBlock ifFalse: [^ false]. assoc receiver arguments isEmpty ifFalse: [self notify: 'caseOf: takes zero-arg blocks'. ^ false]. assoc arguments first isBlock ifFalse: [^ false]. assoc arguments first arguments isEmpty ifFalse: [self notify: 'caseOf: takes zero-arg blocks']. ]. ^ true! ! !RBMessageNode methodsFor: 'inline' stamp: 'md 4/14/2007 00:38'! isInlineIf self receiver isBlock ifTrue: [^ false]. self isCascaded ifTrue: [^ false]. (#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: self selector) ifFalse: [^ false]. self arguments do: [:node | node isBlock ifFalse: [^ false]]. self arguments do: [:block | block arguments isEmpty ifFalse: [ self notify: 'ifTrue:ifFalse: takes zero-arg blocks'. ^ false ] ]. ^ true! ! !RBMessageNode methodsFor: 'inline' stamp: 'md 4/14/2007 00:38'! isInlineIfNil | assertNone assertOneOrNone | self receiver isBlock ifTrue: [^ false]. self isCascaded ifTrue: [^ false]. (#(ifNil: ifNotNil: ifNil:ifNotNil: ifNotNil:ifNil: ifNotNilDo:) includes: self selector) ifFalse: [^ false]. self arguments do: [:node | node isBlock ifFalse: [^ false]]. assertNone := [:block | block arguments isEmpty ifFalse: [self notify: 'ifNil: takes zero-arg block'. ^ false] ]. assertOneOrNone := [:block | block arguments size > 1 ifTrue: [self notify: 'ifNotNil: takes zero- or one-arg block'. ^ false] ]. self selector caseOf: { [#ifNil:] -> [assertNone value: self arguments first]. [#ifNil:ifNotNil:] -> [assertNone value: self arguments first. assertOneOrNone value: self arguments last]. [#ifNotNil:] -> [assertOneOrNone value: self arguments first]. [#ifNotNilDo:] -> [assertOneOrNone value: self arguments first]. [#ifNotNil:ifNil:] -> [assertOneOrNone value: self arguments first. assertNone value: self arguments last] }. ^ true! ! !RBMessageNode methodsFor: 'inline' stamp: 'md 4/14/2007 00:38'! isInlineToDo | block step | self receiver isBlock ifTrue: [^ false]. self isCascaded ifTrue: [^ false]. (#(to:do: to:by:do:) includes: self selector) ifFalse: [^ false]. self arguments first isBlock ifTrue: [^ false]. block := self arguments last. block isBlock ifFalse: [^ false]. block arguments size = 1 ifFalse: [ self notify: 'to:do: block must take one arg'. ^ false]. (ParseTreeSearcher new matches: block arguments first name , ' := `@object' do: [:n :a | true]; executeTree: block initialAnswer: false) ifTrue: [^ false]. self arguments size = 3 "to:by:do:" ifTrue: [ step := self arguments second. step isLiteral ifFalse: [^ false]. step value = 0 ifTrue: [self notify: 'by: step can''t be zero'. ^ false]. ]. ^ true! ! !RBMessageNode methodsFor: 'inline' stamp: 'md 4/14/2007 00:38'! isInlineWhile self isCascaded ifTrue: [^ false]. (#(whileFalse: whileTrue: whileFalse whileTrue) includes: self selector) ifFalse: [^ false]. self receiver isBlock ifFalse: [^ false]. self receiver arguments isEmpty ifFalse: [self notify: 'while receiver block must have no arguments'. ^ false]. self arguments isEmpty ifFalse: [ self arguments first isBlock ifFalse: [^ false]. self arguments first arguments isEmpty ifFalse: [self notify: 'while takes a zero-arg block as its argument'. ^ false]. ]. ^ true! ! !RBMessageNode methodsFor: 'testing' stamp: ''! isKeyword ^selectorParts first value last == $:! ! !RBMessageNode methodsFor: 'testing' stamp: ''! isMessage ^true! ! !RBMessageNode methodsFor: 'testing' stamp: 'pmm 1/9/2006 12:05'! isSelfSend ^(self receiver isVariable) and: [ self receiver name = 'self' ]! ! !RBMessageNode methodsFor: 'testing' stamp: 'pmm 4/24/2006 22:30'! isSuperSend ^receiver isVariable and: [ receiver name = 'super' ] and: [ receiver binding name = 'self']! ! !RBMessageNode methodsFor: 'testing' stamp: 'md 4/6/2007 11:15'! isUnary ^self arguments isEmpty! ! !RBMessageNode methodsFor: 'testing' stamp: 'md 4/6/2007 11:15'! lastIsReturn ^ ((#(ifTrue:ifFalse: ifFalse:ifTrue: ifNil:ifNotNil: ifNotNil:ifNil:) includes: self selector) and: [self arguments first isBlock and: [self arguments first body lastIsReturn and: [self arguments last isBlock and: [self arguments last body lastIsReturn]]]]) or: [(#(caseOf: caseOf:otherwise:) includes: self selector) and: [self arguments first isArray and: [self arguments first statements allSatisfy: [:assocMessage | assocMessage arguments first isBlock and: [assocMessage arguments first body lastIsReturn]]] and: [selector == #caseOf: or: [self arguments second isBlock and: [self arguments second body lastIsReturn]]]]]! ! !RBMessageNode methodsFor: 'matching' stamp: 'pmm 7/12/2006 15:41'! match: aNode inContext: aDictionary aNode class == self class ifFalse: [^false]. self selector == aNode selector ifFalse: [^false]. (receiver match: aNode receiver inContext: aDictionary) ifFalse: [^false]. self arguments with: aNode arguments do: [ :first :second | (first match: second inContext: aDictionary) ifFalse: [^false]]. ^true! ! !RBMessageNode methodsFor: 'copying' stamp: 'md 4/6/2007 11:16'! postCopy super postCopy. receiver := receiver copy. receiver parent: self. arguments ifNotNil: [ arguments := self arguments collect: [:each | each copy parent: self; yourself ]]! ! !RBMessageNode methodsFor: 'accessing' stamp: ''! precedence ^self isUnary ifTrue: [1] ifFalse: [self isKeyword ifTrue: [3] ifFalse: [2]]! ! !RBMessageNode methodsFor: 'accessing' stamp: ''! receiver ^receiver! ! !RBMessageNode methodsFor: 'accessing' stamp: ''! receiver: aValueNode receiver := aValueNode. receiver parent: self! ! !RBMessageNode methodsFor: 'initialize-release' stamp: ''! receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes self receiver: aValueNode. selectorParts := keywordTokens. self arguments: valueNodes! ! !RBMessageNode methodsFor: 'replacing' stamp: 'md 4/8/2007 17:53'! replaceNode: aNode withNode: anotherNode "If we're inside a cascade node and are changing the receiver, change all the receivers" receiver == aNode ifTrue: [self receiver: anotherNode. (parent notNil and: [parent isCascade]) ifTrue: [parent messages do: [:each | each receiver: anotherNode]]]. self arguments: (self arguments collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! ! !RBMessageNode methodsFor: 'accessing' stamp: ''! selector ^selector isNil ifTrue: [selector := self buildSelector] ifFalse: [selector]! ! !RBMessageNode methodsFor: 'accessing' stamp: 'md 4/6/2007 11:17'! selector: aSelector | keywords numArgs | keywords := aSelector keywords. numArgs := aSelector numArgs. numArgs == self arguments size ifFalse: [self error: 'Attempting to assign selector with wrong number of arguments.']. selectorParts := numArgs == 0 ifTrue: [Array with: (RBIdentifierToken value: keywords first start: nil)] ifFalse: [keywords first last == $: ifTrue: [keywords collect: [:each | RBKeywordToken value: each start: nil]] ifFalse: [Array with: (RBBinarySelectorToken value: aSelector start: nil)]]. selector := aSelector! ! !RBMessageNode methodsFor: 'private' stamp: ''! selectorParts ^selectorParts! ! !RBMessageNode methodsFor: 'private' stamp: 'ajh 3/11/2003 23:40'! selectorParts: tokenCollection selectorParts := tokenCollection. selector := nil. ! ! !RBMessageNode methodsFor: 'accessing' stamp: ''! sentMessages ^(super sentMessages) add: self selector; yourself! ! !RBMessageNode methodsFor: 'accessing' stamp: ''! startWithoutParentheses ^receiver start! ! !RBMessageNode methodsFor: 'accessing' stamp: 'md 4/6/2007 11:17'! stopWithoutParentheses ^self arguments isEmpty ifTrue: [selectorParts first stop] ifFalse: [self arguments last stop]! ! RBMessageNode subclass: #RBPatternMessageNode instanceVariableNames: 'isList isCascadeList' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBPatternMessageNode commentStamp: 'md 8/9/2005 14:58' prior: 0! RBPatternMessageNode is a RBMessageNode that will match other message nodes without their selectors being equal. Instance Variables: isCascadeList are we matching a list of message nodes in a cascaded message isList are we matching each keyword or matching all keywords together (e.g., `keyword1: would match a one argument method whereas `@keywords: would match 0 or more arguments)! !RBPatternMessageNode methodsFor: 'matching' stamp: ''! copyInContext: aDictionary | selectors | self isList ifTrue: [^aDictionary at: self]. selectors := self isSelectorList ifTrue: [(aDictionary at: selectorParts first value) keywords] ifFalse: [selectorParts collect: [:each | aDictionary at: each value]]. ^(RBMessageNode new) receiver: (receiver copyInContext: aDictionary); selectorParts: (selectors collect: [:each | (each last == $: ifTrue: [RBKeywordToken] ifFalse: [RBIdentifierToken]) value: each start: nil]); arguments: (self copyList: arguments inContext: aDictionary); yourself! ! !RBPatternMessageNode methodsFor: 'testing-matching' stamp: ''! isList ^isCascadeList and: [parent notNil and: [parent isCascade]]! ! !RBPatternMessageNode methodsFor: 'testing-matching' stamp: ''! isPatternNode ^true! ! !RBPatternMessageNode methodsFor: 'testing-matching' stamp: ''! isSelectorList ^isList! ! !RBPatternMessageNode methodsFor: 'matching' stamp: ''! match: aNode inContext: aDictionary aNode class == self matchingClass ifFalse: [^false]. (receiver match: aNode receiver inContext: aDictionary) ifFalse: [^false]. self isSelectorList ifTrue: [^(aDictionary at: selectorParts first value ifAbsentPut: [aNode selector]) == aNode selector and: [(aDictionary at: arguments first ifAbsentPut: [aNode arguments]) = aNode arguments]]. ^self matchArgumentsAgainst: aNode inContext: aDictionary! ! !RBPatternMessageNode methodsFor: 'matching' stamp: 'pmm 7/12/2006 15:44'! matchArgumentsAgainst: aNode inContext: aDictionary self arguments size == aNode arguments size ifFalse: [^false]. (self matchSelectorAgainst: aNode inContext: aDictionary) ifFalse: [^false]. self arguments with: aNode arguments do: [ :first :second | (first match: second inContext: aDictionary) ifFalse: [^false]]. ^true! ! !RBPatternMessageNode methodsFor: 'matching' stamp: ''! matchSelectorAgainst: aNode inContext: aDictionary | keyword | 1 to: selectorParts size do: [:i | keyword := selectorParts at: i. (aDictionary at: keyword value ifAbsentPut: [keyword isPatternVariable ifTrue: [(aNode selectorParts at: i) value] ifFalse: [keyword value]]) = (aNode selectorParts at: i) value ifFalse: [^false]]. ^true! ! !RBPatternMessageNode methodsFor: 'private' stamp: ''! matchingClass ^RBMessageNode! ! !RBPatternMessageNode methodsFor: 'initialize-release' stamp: ''! receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes | message | super receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes. isCascadeList := isList := false. message := keywordTokens first value. 2 to: message size do: [:i | | character | character := message at: i. character == self listCharacter ifTrue: [isList := true] ifFalse: [character == self cascadeListCharacter ifTrue: [isCascadeList := true] ifFalse: [^self]]]! ! !RBPatternMessageNode methodsFor: 'accessing' stamp: ''! sentMessages ^(super sentMessages) remove: self selector ifAbsent: []; yourself! ! !RBValueNode methodsFor: 'accessing' stamp: 'md 4/2/2007 08:10'! addParenthesis: anInterval self propertyAt: #parenthesis ifAbsentPut: [OrderedCollection new: 1]. (self propertyAt: #parenthesis) add: anInterval! ! !RBValueNode methodsFor: 'testing' stamp: ''! containedBy: anInterval ^anInterval first <= self startWithoutParentheses and: [anInterval last >= self stopWithoutParentheses]! ! !RBValueNode methodsFor: 'testing' stamp: ''! hasParentheses ^self parentheses isEmpty not! ! !RBValueNode methodsFor: 'testing' stamp: ''! isValue ^true! ! !RBValueNode methodsFor: 'accessing' stamp: 'md 4/2/2007 08:10'! parentheses ^self propertyAt: #parenthesis ifAbsent: [#()].! ! !RBValueNode methodsFor: 'accessing' stamp: 'md 4/6/2007 14:05'! start ^(self hasProperty: #parenthesis) ifFalse: [self startWithoutParentheses] ifTrue: [self parentheses last first]! ! !RBValueNode methodsFor: 'accessing' stamp: ''! startWithoutParentheses ^self subclassResponsibility! ! !RBValueNode methodsFor: 'accessing' stamp: 'md 4/6/2007 14:05'! stop ^(self hasProperty: #parenthesis) ifFalse: [self stopWithoutParentheses] ifTrue: [self parentheses last last]! ! !RBValueNode methodsFor: 'accessing' stamp: ''! stopWithoutParentheses ^self subclassResponsibility! ! RBValueNode subclass: #RBVariableNode instanceVariableNames: 'token name' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBVariableNode commentStamp: 'md 8/9/2005 15:00' prior: 0! RBVariableNode is an AST node that represent a variable (global, inst var, temp, etc.). Instance Variables: token the token that contains our name and position ! RBVariableNode subclass: #RBPatternVariableNode instanceVariableNames: 'recurseInto isList isLiteral isStatement isAnything' classVariableNames: '' poolDictionaries: '' category: 'AST-Nodes'! !RBPatternVariableNode commentStamp: 'md 8/9/2005 14:59' prior: 0! RBPatternVariableNode is an AST node that is used to match several other types of nodes (literals, variables, value nodes, statement nodes, and sequences of statement nodes). The different types of matches are determined by the name of the node. If the name contains a # character, then it will match a literal. If it contains, a . then it matches statements. If it contains no extra characters, then it matches only variables. These options are mutually exclusive. The @ character can be combined with the name to match lists of items. If combined with the . character, then it will match a list of statement nodes (0 or more). If used without the . or # character, then it matches anything except for list of statements. Combining the @ with the # is not supported. Adding another ` in the name will cause the search/replace to look for more matches inside the node that this node matched. This option should not be used for top level expressions since that would cause infinite recursion (e.g., searching only for "``@anything"). Instance Variables: isAnything can we match any type of node isList can we match a list of items (@) isLiteral only match a literal node (#) isStatement only match statements (.) recurseInto search for more matches in the node we match (`) ! !RBPatternVariableNode methodsFor: 'matching' stamp: ''! copyInContext: aDictionary ^aDictionary at: self! ! !RBPatternVariableNode methodsFor: 'initialize-release' stamp: ''! identifierToken: anIdentifierToken super identifierToken: anIdentifierToken. self initializePatternVariables! ! !RBPatternVariableNode methodsFor: 'initialize-release' stamp: ''! initializePatternVariables | name | name := self name. isAnything := isList := isLiteral := isStatement := recurseInto := false. 2 to: name size do: [:i | | character | character := name at: i. character == self listCharacter ifTrue: [isAnything := isList := true] ifFalse: [character == self literalCharacter ifTrue: [isLiteral := true] ifFalse: [character == self statementCharacter ifTrue: [isStatement := true] ifFalse: [character == self recurseIntoCharacter ifTrue: [recurseInto := true] ifFalse: [^self]]]]]! ! !RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''! isAnything ^isAnything! ! !RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''! isList ^isList! ! !RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''! isLiteral ^isLiteral! ! !RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''! isPatternNode ^true! ! !RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''! isStatement ^isStatement! ! !RBPatternVariableNode methodsFor: 'matching' stamp: ''! match: aNode inContext: aDictionary self isAnything ifTrue: [^(aDictionary at: self ifAbsentPut: [aNode]) = aNode]. self isLiteral ifTrue: [^self matchLiteral: aNode inContext: aDictionary]. self isStatement ifTrue: [^self matchStatement: aNode inContext: aDictionary]. aNode class == self matchingClass ifFalse: [^false]. ^(aDictionary at: self ifAbsentPut: [aNode]) = aNode! ! !RBPatternVariableNode methodsFor: 'matching' stamp: ''! matchLiteral: aNode inContext: aDictionary ^aNode class == RBLiteralNode and: [(aDictionary at: self ifAbsentPut: [aNode]) = aNode]! ! !RBPatternVariableNode methodsFor: 'matching' stamp: ''! matchStatement: aNode inContext: aDictionary (aNode parent notNil and: [aNode parent isSequence]) ifFalse: [^false]. ^(aDictionary at: self ifAbsentPut: [aNode]) = aNode! ! !RBPatternVariableNode methodsFor: 'private' stamp: ''! matchingClass ^RBVariableNode! ! !RBPatternVariableNode methodsFor: 'accessing' stamp: ''! parent: aBRProgramNode "Fix the case where '``@node' should match a single node, not a sequence node." super parent: aBRProgramNode. parent isSequence ifTrue: [(self isStatement or: [parent temporaries includes: self]) ifFalse: [isList := false]]! ! !RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''! recurseInto ^recurseInto! ! !RBVariableNode class methodsFor: 'instance creation' stamp: ''! identifierToken: anIdentifierToken ^(anIdentifierToken isPatternVariable ifTrue: [RBPatternVariableNode] ifFalse: [RBVariableNode]) new identifierToken: anIdentifierToken! ! !RBVariableNode class methodsFor: 'instance creation' stamp: ''! named: aString ^self identifierToken: (RBIdentifierToken value: aString start: 0)! ! !RBVariableNode methodsFor: 'comparing' stamp: ''! = anObject self == anObject ifTrue: [^true]. self class = anObject class ifFalse: [^false]. ^self name = anObject name! ! !RBVariableNode methodsFor: 'visitor' stamp: ''! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptVariableNode: self! ! !RBVariableNode methodsFor: 'replacing' stamp: 'ajh 3/13/2003 16:13'! adjustPositionsAfter: sourcePos by: delta "Slide token positions after sourcePos by delta" token start > sourcePos ifTrue: [ token start: token start + delta]! ! !RBVariableNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:44'! basicFirstToken ^self token! ! !RBVariableNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:45'! basicLastToken ^self token! ! !RBVariableNode methodsFor: 'semantics' stamp: 'md 4/2/2007 08:07'! binding ^ self propertyAt: #binding ifAbsent: [nil].! ! !RBVariableNode methodsFor: 'semantics' stamp: 'md 4/2/2007 08:07'! binding: aSemVar aSemVar ifNil: [^self removeProperty: #binding ifAbsent: []]. self propertyAt: #binding put: aSemVar.! ! !RBVariableNode methodsFor: 'replacing' stamp: 'ajh 3/17/2003 13:12'! changeToken: newToken self root adjustPositionsAfter: token stop by: newToken stop - token stop. token := newToken. ! ! !RBVariableNode methodsFor: 'matching' stamp: ''! copyInContext: aDictionary ^self class identifierToken: token removePositions! ! !RBVariableNode methodsFor: 'comparing' stamp: ''! equalTo: anObject withMapping: aDictionary self class = anObject class ifFalse: [^false]. ^(aDictionary at: self name ifAbsentPut: [anObject name]) = anObject name! ! !RBVariableNode methodsFor: 'comparing' stamp: ''! hash ^self name hash! ! !RBVariableNode methodsFor: 'initialize-release' stamp: 'md 4/13/2007 22:39'! identifierToken: anIdentifierToken token := anIdentifierToken. name := anIdentifierToken value.! ! !RBVariableNode methodsFor: 'testing' stamp: 'pmm 10/8/2005 11:21'! isGlobal ^self binding isGlobal! ! !RBVariableNode methodsFor: 'testing' stamp: ''! isImmediate ^true! ! !RBVariableNode methodsFor: 'testing' stamp: 'pmm 10/8/2005 11:57'! isInstance ^self binding isInstance! ! !RBVariableNode methodsFor: 'testing' stamp: 'pmm 2/6/2006 12:31'! isRead ^self isWrite not! ! !RBVariableNode methodsFor: 'testing' stamp: 'pmm 10/8/2005 11:21'! isTemp ^self binding isTemp! ! !RBVariableNode methodsFor: 'testing' stamp: ''! isVariable ^true! ! !RBVariableNode methodsFor: 'testing' stamp: 'pmm 2/6/2006 12:31'! isWrite ^self parent isAssignment and: [ self parent variable == self ]! ! !RBVariableNode methodsFor: 'accessing' stamp: 'md 4/13/2007 22:42'! name ^name! ! !RBVariableNode methodsFor: 'accessing' stamp: ''! precedence ^0! ! !RBVariableNode methodsFor: 'testing' stamp: ''! references: aVariableName ^self name = aVariableName! ! !RBVariableNode methodsFor: 'accessing' stamp: ''! startWithoutParentheses ^token start! ! !RBVariableNode methodsFor: 'accessing' stamp: ''! stopWithoutParentheses ^token stop! ! !RBVariableNode methodsFor: 'accessing' stamp: 'ajh 3/13/2003 15:17'! token ^ token! ! Object subclass: #RBProgramNodeVisitor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Visitors'! !RBProgramNodeVisitor commentStamp: '' prior: 0! RBProgramNodeVisitor is an abstract visitor for the RBProgramNodes. Here is a short Tutorial. We want to parse an expression: tree := RBParser parseExpression: '3 + 4' Now we have the AST (Abstrakt syntax tree). Have a look at it with the ObjectExplorerer: tree explore We can easyly walk across the tree using the RBProgramNodeVisitor: RBProgramNodeVisitor new visitNode: tree. Of course, nothing happens, as all the visitor-methods are only stubs in this class. So you need to subclass that to do anything usefull. As an example, we would like to walk the tree and get all Literals back. So we make a subclass: RBProgramNodeVisitor subclass: #TestVisitor instanceVariableNames: 'literals' classVariableNames: '' poolDictionaries: '' category: 'Compiler-AST-Visitors' initialize literals := Set new. literals ^literals acceptLiteralNode: aLiteralNode literals add: aLiteralNode value. (TestVisitor new visitNode: tree) literals ! RBProgramNodeVisitor subclass: #ParseTreeSearcher instanceVariableNames: 'searches answer argumentSearches context messages' classVariableNames: '' poolDictionaries: '' category: 'AST-ParseTree Matching'! !ParseTreeSearcher commentStamp: 'md 8/9/2005 14:55' prior: 0! ParseTreeSearcher walks over a normal source code parse tree using the visitor pattern, and then matches these nodes against the meta-nodes using the match:inContext: methods defined for the meta-nodes. Instance Variables: answer the "answer" that is propagated between matches argumentSearches argument searches (search for the BRProgramNode and perform the BlockClosure when its found) context a dictionary that contains what each meta-node matches against. This could be a normal Dictionary that is created for each search, but is created once and reused (efficiency). messages the sent messages in our searches searches non-argument searches (search for the BRProgramNode and perform the BlockClosure when its found)! ParseTreeSearcher subclass: #ParseTreeRewriter instanceVariableNames: 'tree' classVariableNames: '' poolDictionaries: '' category: 'AST-ParseTree Matching'! !ParseTreeRewriter commentStamp: 'md 8/9/2005 14:55' prior: 0! ParseTreeRewriter walks over and transforms its RBProgramNode (tree). If the tree is modified, then answer is set to true, and the modified tree can be retrieved by the #tree method. Instance Variables: tree the parse tree we're transforming! !ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''! classVariable: aVarName getter: getMethod setter: setMethod ^self variable: aVarName getter: getMethod setter: setMethod receiver: 'self class'! ! !ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''! removeTemporaryNamed: aName | rewriteRule | rewriteRule := self new. rewriteRule replace: '| `@temps1 ' , aName , ' `@temps2 | ``@.Statements' with: '| `@temps1 `@temps2 | ``@.Statements'. ^rewriteRule! ! !ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''! rename: varName to: newVarName | rewriteRule | rewriteRule := self new. rewriteRule replace: varName with: newVarName; replaceArgument: varName with: newVarName. ^rewriteRule! ! !ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''! rename: varName to: newVarName handler: aBlock "Rename varName to newVarName, evaluating aBlock if there is a temporary variable with the same name as newVarName. This does not change temporary variables with varName." | rewriteRule | rewriteRule := self new. rewriteRule replace: varName with: newVarName; replaceArgument: newVarName withValueFrom: [:aNode | aBlock value. aNode]. ^rewriteRule! ! !ParseTreeRewriter class methodsFor: 'accessing' stamp: ''! replace: code with: newCode in: aParseTree ^(self replace: code with: newCode method: false) executeTree: aParseTree; tree! ! !ParseTreeRewriter class methodsFor: 'accessing' stamp: ''! replace: code with: newCode in: aParseTree onInterval: anInterval | rewriteRule | rewriteRule := self new. ^rewriteRule replace: code with: newCode when: [:aNode | aNode intersectsInterval: anInterval]; executeTree: aParseTree; tree! ! !ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''! replace: code with: newCode method: aBoolean | rewriteRule | rewriteRule := self new. aBoolean ifTrue: [rewriteRule replaceMethod: code with: newCode] ifFalse: [rewriteRule replace: code with: newCode]. ^rewriteRule! ! !ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''! replaceLiteral: literal with: newLiteral | rewriteRule | rewriteRule := self new. rewriteRule replace: '`#literal' withValueFrom: [:aNode | aNode] when: [:aNode | self replaceLiteral: literal with: newLiteral inToken: aNode token]. ^rewriteRule! ! !ParseTreeRewriter class methodsFor: 'private' stamp: ''! replaceLiteral: literal with: newLiteral inToken: literalToken | value | value := literalToken realValue. (value class = literal class and: [value = literal]) ifTrue: [literalToken value: newLiteral start: nil stop: nil. ^true]. ^value class == Array and: [literalToken value inject: false into: [:bool :each | bool | (self replaceLiteral: literal with: newLiteral inToken: each)]]! ! !ParseTreeRewriter class methodsFor: 'accessing' stamp: ''! replaceStatements: code with: newCode in: aParseTree onInterval: anInterval | tree searchStmt replaceStmt | tree := self buildTree: code method: false. tree lastIsReturn ifTrue: [searchStmt := '| `@temps | `@.Statements. ' , code. replaceStmt := '| `@temps | `@.Statements. ^' , newCode] ifFalse: [searchStmt := '| `@temps | `@.Statements1. ' , code , '. `@.Statements2'. replaceStmt := '| `@temps | `@.Statements1. ' , newCode , '. `@.Statements2']. ^self replace: searchStmt with: replaceStmt in: aParseTree onInterval: anInterval! ! !ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''! variable: aVarName getter: getMethod setter: setMethod ^self variable: aVarName getter: getMethod setter: setMethod receiver: 'self'! ! !ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''! variable: aVarName getter: getMethod setter: setMethod receiver: aString | rewriteRule | rewriteRule := self new. rewriteRule replace: aVarName , ' := ``@object' with: aString , ' ' , setMethod , ' ``@object'; replace: aVarName with: aString , ' ' , getMethod. ^rewriteRule! ! !ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: ''! acceptAssignmentNode: anAssignmentNode anAssignmentNode variable: (self visitNode: anAssignmentNode variable). anAssignmentNode value: (self visitNode: anAssignmentNode value)! ! !ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'nk 1/29/2005 11:10'! acceptBlockNode: aBlockNode aBlockNode arguments: (self visitBlockArguments: aBlockNode arguments). aBlockNode body: (self visitNode: aBlockNode body)! ! !ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: ''! acceptCascadeNode: aCascadeNode | newMessages notFound | newMessages := OrderedCollection new: aCascadeNode messages size. notFound := OrderedCollection new: aCascadeNode messages size. aCascadeNode messages do: [:each | | newNode | newNode := self performSearches: searches on: each. newNode isNil ifTrue: [newNode := each. notFound add: newNode]. newNode isMessage ifTrue: [newMessages add: newNode] ifFalse: [newNode isCascade ifTrue: [newMessages addAll: newNode messages] ifFalse: [Transcript show: 'Cannot replace message node inside of cascaded node with non-message node.'; cr. newMessages add: each]]]. notFound size == aCascadeNode messages size ifTrue: [| receiver | receiver := self visitNode: aCascadeNode messages first receiver. newMessages do: [:each | each receiver: receiver]]. notFound do: [:each | each arguments: (each arguments collect: [:arg | self visitNode: arg])]. aCascadeNode messages: newMessages! ! !ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: ''! acceptMessageNode: aMessageNode aMessageNode receiver: (self visitNode: aMessageNode receiver). aMessageNode arguments: (aMessageNode arguments collect: [:each | self visitNode: each])! ! !ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'nk 1/29/2005 11:10'! acceptMethodNode: aMethodNode aMethodNode arguments: (self visitMethodArguments: aMethodNode arguments). aMethodNode body: (self visitNode: aMethodNode body)! ! !ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: ''! acceptReturnNode: aReturnNode aReturnNode value: (self visitNode: aReturnNode value)! ! !ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'nk 1/29/2005 11:10'! acceptSequenceNode: aSequenceNode aSequenceNode temporaries: (self visitTemporaryVariables: aSequenceNode temporaries). aSequenceNode statements: (aSequenceNode statements collect: [:each | self visitNode: each])! ! !ParseTreeRewriter methodsFor: 'accessing' stamp: ''! executeTree: aParseTree | oldContext | oldContext := context. context := RBSmallDictionary new. answer := false. tree := self visitNode: aParseTree. context := oldContext. ^answer! ! !ParseTreeRewriter methodsFor: 'private' stamp: ''! foundMatch answer := true! ! !ParseTreeRewriter methodsFor: 'private' stamp: ''! lookForMoreMatchesInContext: oldContext oldContext keysAndValuesDo: [:key :value | (key isString not and: [key recurseInto]) ifTrue: [oldContext at: key put: (value collect: [:each | self visitNode: each])]]! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replace: searchString with: replaceString self addRule: (RBStringReplaceRule searchFor: searchString replaceWith: replaceString)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replace: searchString with: replaceString when: aBlock self addRule: (RBStringReplaceRule searchFor: searchString replaceWith: replaceString when: aBlock)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replace: searchString withValueFrom: replaceBlock self addRule: (RBBlockReplaceRule searchFor: searchString replaceWith: replaceBlock)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replace: searchString withValueFrom: replaceBlock when: conditionBlock self addRule: (RBBlockReplaceRule searchFor: searchString replaceWith: replaceBlock when: conditionBlock)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replaceArgument: searchString with: replaceString self addArgumentRule: (RBStringReplaceRule searchFor: searchString replaceWith: replaceString)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replaceArgument: searchString with: replaceString when: aBlock self addArgumentRule: (RBStringReplaceRule searchFor: searchString replaceWith: replaceString when: aBlock)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replaceArgument: searchString withValueFrom: replaceBlock self addArgumentRule: (RBBlockReplaceRule searchFor: searchString replaceWith: replaceBlock)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replaceArgument: searchString withValueFrom: replaceBlock when: conditionBlock self addArgumentRule: (RBBlockReplaceRule searchFor: searchString replaceWith: replaceBlock when: conditionBlock)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replaceMethod: searchString with: replaceString self addRule: (RBStringReplaceRule searchForMethod: searchString replaceWith: replaceString)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replaceMethod: searchString with: replaceString when: aBlock self addRule: (RBStringReplaceRule searchForMethod: searchString replaceWith: replaceString when: aBlock)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replaceMethod: searchString withValueFrom: replaceBlock self addRule: (RBBlockReplaceRule searchForMethod: searchString replaceWith: replaceBlock)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replaceMethod: searchString withValueFrom: replaceBlock when: conditionBlock self addRule: (RBBlockReplaceRule searchForMethod: searchString replaceWith: replaceBlock when: conditionBlock)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replaceTree: searchTree withTree: replaceTree self addRule: (RBStringReplaceRule searchForTree: searchTree replaceWith: replaceTree)! ! !ParseTreeRewriter methodsFor: 'replacing' stamp: ''! replaceTree: searchTree withTree: replaceTree when: aBlock self addRule: (RBStringReplaceRule searchForTree: searchTree replaceWith: replaceTree when: aBlock)! ! !ParseTreeRewriter methodsFor: 'accessing' stamp: ''! tree ^tree! ! !ParseTreeRewriter methodsFor: 'visiting' stamp: ''! visitArguments: aNodeCollection ^aNodeCollection collect: [:each | self visitArgument: each]! ! !ParseTreeRewriter methodsFor: 'visiting' stamp: 'nk 2/23/2005 15:20'! visitBlockArguments: aNodeCollection ^aNodeCollection collect: [:each | self visitBlockArgument: each]! ! !ParseTreeRewriter methodsFor: 'visiting' stamp: 'nk 2/23/2005 15:21'! visitMethodArguments: aNodeCollection ^aNodeCollection collect: [:each | self visitMethodArgument: each]! ! !ParseTreeRewriter methodsFor: 'visiting' stamp: 'nk 2/23/2005 15:22'! visitTemporaryVariables: aNodeCollection ^aNodeCollection collect: [:each | self visitTemporaryVariable: each]! ! !ParseTreeSearcher class methodsFor: 'private' stamp: ''! buildSelectorString: aSelector | stream keywords | aSelector numArgs = 0 ifTrue: [^aSelector]. stream := WriteStream on: String new. keywords := aSelector keywords. 1 to: keywords size do: [:i | stream nextPutAll: (keywords at: i); nextPutAll: ' ``@arg'; nextPutAll: i printString; nextPut: $ ]. ^stream contents! ! !ParseTreeSearcher class methodsFor: 'private' stamp: ''! buildSelectorTree: aSelector aSelector isEmpty ifTrue: [^nil]. ^RBParser parseRewriteExpression: '``@receiver ' , (self buildSelectorString: aSelector) onError: [:err :pos | ^nil]! ! !ParseTreeSearcher class methodsFor: 'private' stamp: ''! buildTree: aString method: aBoolean ^aBoolean ifTrue: [RBParser parseRewriteMethod: aString] ifFalse: [RBParser parseRewriteExpression: aString]! ! !ParseTreeSearcher class methodsFor: 'instance creation' stamp: ''! getterMethod: aVarName ^(self new) matchesMethod: '`method ^' , aVarName do: [:aNode :ans | aNode selector]; yourself! ! !ParseTreeSearcher class methodsFor: 'instance creation' stamp: ''! justSendsSuper ^(self new) matchesAnyMethodOf: #('`@method: `@Args ^super `@method: `@Args' '`@method: `@Args super `@method: `@Args') do: [:aNode :ans | true]; yourself! ! !ParseTreeSearcher class methodsFor: 'instance creation' stamp: ''! returnSetterMethod: aVarName ^(self new) matchesMethod: '`method: `Arg ^' , aVarName , ' := `Arg' do: [:aNode :ans | aNode selector]; yourself! ! !ParseTreeSearcher class methodsFor: 'instance creation' stamp: ''! setterMethod: aVarName ^(self new) matchesAnyMethodOf: (Array with: '`method: `Arg ' , aVarName , ' := `Arg' with: '`method: `Arg ^' , aVarName , ' := `Arg') do: [:aNode :ans | aNode selector]; yourself! ! !ParseTreeSearcher class methodsFor: 'accessing' stamp: ''! treeMatching: aString in: aParseTree (self new) matches: aString do: [:aNode :answer | ^aNode]; executeTree: aParseTree. ^nil! ! !ParseTreeSearcher class methodsFor: 'accessing' stamp: ''! treeMatchingStatements: aString in: aParseTree | notifier tree lastIsReturn | notifier := self new. tree := RBParser parseExpression: aString. lastIsReturn := tree lastIsReturn. notifier matches: (lastIsReturn ifTrue: ['| `@temps | `@.S1. ' , tree formattedCode] ifFalse: ['| `@temps | `@.S1. ' , tree formattedCode , '. `@.S2']) do: [:aNode :answer | ^tree]. notifier executeTree: aParseTree. ^nil! ! !ParseTreeSearcher methodsFor: 'accessing' stamp: ''! addArgumentRule: aParseTreeRule argumentSearches add: aParseTreeRule. aParseTreeRule owner: self! ! !ParseTreeSearcher methodsFor: 'accessing' stamp: ''! addArgumentRules: ruleCollection ruleCollection do: [:each | self addArgumentRule: each]! ! !ParseTreeSearcher methodsFor: 'accessing' stamp: ''! addRule: aParseTreeRule searches add: aParseTreeRule. aParseTreeRule owner: self! ! !ParseTreeSearcher methodsFor: 'accessing' stamp: ''! addRules: ruleCollection ruleCollection do: [:each | self addRule: each]! ! !ParseTreeSearcher methodsFor: 'accessing' stamp: ''! answer ^answer! ! !ParseTreeSearcher methodsFor: 'initialize-release' stamp: ''! answer: anObject answer := anObject! ! !ParseTreeSearcher methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:17'! canMatchMethod: aCompiledMethod ^self messages isEmpty or: [ self messages anySatisfy: [:each | aCompiledMethod sendsSelector: each] ]! ! !ParseTreeSearcher methodsFor: 'accessing' stamp: ''! context ^context! ! !ParseTreeSearcher methodsFor: 'accessing' stamp: ''! executeMethod: aParseTree initialAnswer: anObject answer := anObject. searches detect: [:each | (each performOn: aParseTree) notNil] ifNone: []. ^answer! ! !ParseTreeSearcher methodsFor: 'accessing' stamp: ''! executeTree: aParseTree "Save our current context, in case someone is performing another search inside a match." | oldContext | oldContext := context. context := RBSmallDictionary new. self visitNode: aParseTree. context := oldContext. ^answer! ! !ParseTreeSearcher methodsFor: 'accessing' stamp: ''! executeTree: aParseTree initialAnswer: aValue answer := aValue. ^self executeTree: aParseTree! ! !ParseTreeSearcher methodsFor: 'private' stamp: ''! foundMatch! ! !ParseTreeSearcher methodsFor: 'initialize-release' stamp: ''! initialize super initialize. context := RBSmallDictionary new. searches := OrderedCollection new. argumentSearches := OrderedCollection new: 0. answer := nil! ! !ParseTreeSearcher methodsFor: 'private' stamp: ''! lookForMoreMatchesInContext: oldContext oldContext keysAndValuesDo: [:key :value | (key isString not and: [key recurseInto]) ifTrue: [value do: [:each | self visitNode: each]]]! ! !ParseTreeSearcher methodsFor: 'searching' stamp: ''! matches: aString do: aBlock self addRule: (RBSearchRule searchFor: aString thenDo: aBlock)! ! !ParseTreeSearcher methodsFor: 'searching' stamp: ''! matchesAnyArgumentOf: stringCollection do: aBlock stringCollection do: [:each | self matchesArgument: each do: aBlock]! ! !ParseTreeSearcher methodsFor: 'searching' stamp: ''! matchesAnyMethodOf: aStringCollection do: aBlock aStringCollection do: [:each | self matchesMethod: each do: aBlock]! ! !ParseTreeSearcher methodsFor: 'searching' stamp: ''! matchesAnyOf: aStringCollection do: aBlock aStringCollection do: [:each | self matches: each do: aBlock]! ! !ParseTreeSearcher methodsFor: 'searching' stamp: ''! matchesAnyTreeOf: treeCollection do: aBlock treeCollection do: [:each | self matchesTree: each do: aBlock]! ! !ParseTreeSearcher methodsFor: 'searching' stamp: ''! matchesArgument: aString do: aBlock self addArgumentRule: (RBSearchRule searchFor: aString thenDo: aBlock)! ! !ParseTreeSearcher methodsFor: 'searching' stamp: ''! matchesArgumentTree: aBRProgramNode do: aBlock self addArgumentRule: (RBSearchRule searchForTree: aBRProgramNode thenDo: aBlock)! ! !ParseTreeSearcher methodsFor: 'searching' stamp: ''! matchesMethod: aString do: aBlock self addRule: (RBSearchRule searchForMethod: aString thenDo: aBlock)! ! !ParseTreeSearcher methodsFor: 'searching' stamp: ''! matchesTree: aBRProgramNode do: aBlock self addRule: (RBSearchRule searchForTree: aBRProgramNode thenDo: aBlock)! ! !ParseTreeSearcher methodsFor: 'accessing' stamp: ''! messages messages notNil ifTrue: [^messages]. argumentSearches isEmpty ifFalse: [^messages := #()]. messages := Set new. searches do: [:each | | searchMessages | searchMessages := each sentMessages. RBProgramNode optimizedSelectors do: [:sel | searchMessages remove: sel ifAbsent: []]. searchMessages isEmpty ifTrue: [^messages := #()]. messages addAll: searchMessages]. ^messages := messages asArray! ! !ParseTreeSearcher methodsFor: 'private' stamp: 'pmm 7/12/2006 15:35'! performSearches: aSearchCollection on: aNode | value | aSearchCollection do: [ :each | value := each performOn: aNode. value notNil ifTrue: [ self foundMatch. ^value ] ]. ^nil! ! !ParseTreeSearcher methodsFor: 'private' stamp: ''! recusivelySearchInContext "We need to save the matched context since the other searches might overwrite it." | oldContext | oldContext := context. context := RBSmallDictionary new. self lookForMoreMatchesInContext: oldContext. context := oldContext! ! !ParseTreeSearcher methodsFor: 'visiting' stamp: ''! visitArgument: aNode | value | value := self performSearches: argumentSearches on: aNode. ^value isNil ifTrue: [aNode acceptVisitor: self. aNode] ifFalse: [value]! ! !ParseTreeSearcher methodsFor: 'visiting' stamp: ''! visitNode: aNode | value | value := self performSearches: searches on: aNode. ^value isNil ifTrue: [aNode acceptVisitor: self. aNode] ifFalse: [value]! ! RBProgramNodeVisitor subclass: #RBFormatter instanceVariableNames: 'codeStream lineStart firstLineLength tabs positionDelta' classVariableNames: '' poolDictionaries: '' category: 'AST-Visitors'! !RBFormatter commentStamp: 'md 8/9/2005 14:50' prior: 0! RBFormatter formats a parse tree. It is an example of a Visitor. This is rarely called directly. Sending 'formattedCode' to a parse tree uses this algorithm to return a pretty-printed version. Instance Variables: codeStream The buffer where the output is accumulated. firstLineLength The length of the first line of a message send. lineStart The position of the current line's start. tabs The number of tabs currently indented. ! RBFormatter subclass: #RBColorFormatter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Visitors'! !RBColorFormatter commentStamp: '' prior: 0! I am a specialization of RBFormatter that produces a colorized Text instead of a String as my formatted output.! !RBColorFormatter methodsFor: 'visitor-double dispatching' stamp: 'nk 3/3/2005 10:50'! acceptLiteralNode: aNode codeStream withStyleFor: #literal do: [ super acceptLiteralNode: aNode ]! ! !RBColorFormatter methodsFor: 'visitor-double dispatching' stamp: 'nk 3/3/2005 11:21'! acceptVariableNode: aNode | definer usage | definer := aNode whoDefines: aNode name. usage := #variable. definer ifNotNil: [ definer isBlock ifTrue: [ usage := #blockArgument ]. definer isMethod ifTrue: [ usage := #methodArgument ]. definer isSequence ifTrue: [ usage := #temporaryVariable ]. ]. ^codeStream withStyleFor: usage do: [ super acceptVariableNode: aNode ]! ! !RBColorFormatter methodsFor: 'private-formatting' stamp: 'nk 3/3/2005 10:51'! formatMessageSelectorPart: part ^codeStream withStyleFor: #keyword do: [ super formatMessageSelectorPart: part ] ! ! !RBColorFormatter methodsFor: 'private-formatting' stamp: 'nk 3/3/2005 10:55'! formatStatementCommentFor: aNode ^codeStream withStyleFor: #comment do: [ super formatStatementCommentFor: aNode ] ! ! !RBColorFormatter methodsFor: 'initialize-release' stamp: 'md 9/1/2005 13:50'! initialize super initialize. codeStream := ColoredCodeStream on: (Text new: 400).! ! !RBColorFormatter methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:15'! visitBlockArgument: aNode ^codeStream withStyleFor: #blockArgument do: [ super visitBlockArgument: aNode ]! ! !RBColorFormatter methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:15'! visitMethodArgument: aNode ^codeStream withStyleFor: #methodArgument do: [ super visitMethodArgument: aNode ]! ! !RBColorFormatter methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:15'! visitTemporaryVariable: aNode ^codeStream withStyleFor: #temporaryVariable do: [ super visitTemporaryVariable: aNode ]! ! !RBFormatter class methodsFor: 'as yet unclassified' stamp: 'md 2/26/2006 15:18'! assignmentOperator ^':='! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'md 8/5/2005 11:09'! acceptArrayNode: anArrayNode anArrayNode start ifNil: [anArrayNode leftBrace: self fullPosition + 1]. self maybeJoinLinesFrom: [ codeStream nextPutAll: '{ '. self indent: 1 while: [ self indent. self formatStatementsFor: anArrayNode. ]. ]. codeStream nextPutAll: '}'. anArrayNode stop ifNil: [anArrayNode rightBrace: self fullPosition]. ! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'md 8/12/2005 11:19'! acceptAssignmentNode: anAssignmentNode self indent: 2 while: [self visitNode: anAssignmentNode variable. codeStream space; nextPutAll: self class assignmentOperator; space. self visitNode: anAssignmentNode value]! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'md 8/12/2005 10:51'! acceptBlockNode: aBlockNode | seqNode multiline formattedBody formatter start | seqNode := aBlockNode body. formatter := (self copy) lineStart: 0; yourself. start := self fullPosition. formattedBody := formatter format: seqNode. multiline := self lineLength + formattedBody size > self maxLineSize or: [formatter isMultiLine]. multiline ifTrue: [self indent]. codeStream nextPut: $[. aBlockNode left ifNil: [aBlockNode left: self fullPosition]. aBlockNode arguments do: [:each | codeStream nextPut: $:. self visitBlockArgument: each. codeStream nextPut: $ ]. aBlockNode arguments isEmpty ifFalse: [codeStream nextPutAll: '| '. multiline ifTrue: [self indent]]. aBlockNode right ifNil: [ "assume if block had no position seqNode had no position also" seqNode adjustPositionsAfter: start by: self fullPosition - start. ]. codeStream nextPutAll: formattedBody. codeStream nextPut: $]. aBlockNode right ifNil: [aBlockNode right: self fullPosition]. ! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'md 2/26/2006 15:01'! acceptCascadeNode: aCascadeNode | messages | messages := aCascadeNode messages. self visitNode: messages first receiver. self indentWhile: [messages do: [:each | self indent; indentWhile: [self formatMessage: each cascade: true]] separatedBy: [codeStream nextPut: $;]]! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'lr 1/4/2007 10:11'! acceptLiteralNode: aLiteralNode | start | start := self fullPosition + 1. self formatLiteral: aLiteralNode value. aLiteralNode token start ifNil: [ aLiteralNode token start: start ]! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: ''! acceptMessageNode: aMessageNode | newFormatter code | newFormatter := self copy. code := newFormatter format: aMessageNode receiver. codeStream nextPutAll: code. codeStream nextPut: $ . newFormatter isMultiLine ifTrue: [lineStart := codeStream position - newFormatter lastLineLength]. self indent: (newFormatter isMultiLine ifTrue: [2] ifFalse: [1]) while: [self formatMessage: aMessageNode cascade: false]! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'SR 9/3/2006 10:13'! acceptMethodNode: aMethodNode self formatMethodPatternFor: aMethodNode. self indentWhile: [ self formatPragmasFor: aMethodNode. self formatMethodCommentFor: aMethodNode indentBefore: true. self indent. self tagBeforeTemporaries ifTrue: [self formatTagFor: aMethodNode]. aMethodNode body statements isEmpty ifFalse: [self visitNode: aMethodNode body]] ! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'ms 9/4/2006 22:48'! acceptPragmaNode: aPragmaNode aPragmaNode pragma printOn: codeStream ! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'ajh 3/24/2003 13:15'! acceptPseudoNode: aPseudoNode aPseudoNode isLabel ifTrue: [ codeStream nextPut: $L. aPseudoNode destination printOn: codeStream. ^ self]. aPseudoNode isGoto ifTrue: [ codeStream nextPut: $G. aPseudoNode destination printOn: codeStream. ^ self]. aPseudoNode isIf ifTrue: [ codeStream nextPutAll: 'If '. codeStream nextPut: (aPseudoNode boolean ifTrue: [$t] ifFalse: [$f]). codeStream space. aPseudoNode destination printOn: codeStream. codeStream space. aPseudoNode otherwise printOn: codeStream. ^ self]. ! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'ajh 3/19/2003 14:13'! acceptReturnNode: aReturnNode aReturnNode start ifNil: [aReturnNode return: self fullPosition + 1]. codeStream nextPut: $^; space. self visitNode: aReturnNode value! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: ''! acceptSequenceNode: aSequenceNode self formatMethodCommentFor: aSequenceNode indentBefore: false. self formatTemporariesFor: aSequenceNode. self tagBeforeTemporaries ifFalse: [| parent | parent := aSequenceNode parent. (parent notNil and: [parent isMethod]) ifTrue: [self formatTagFor: parent]]. self formatStatementsFor: aSequenceNode! ! !RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'ajh 3/19/2003 14:13'! acceptVariableNode: aVariableNode aVariableNode token start ifNil: [ aVariableNode token start: self fullPosition + 1]. codeStream nextPutAll: aVariableNode name! ! !RBFormatter methodsFor: 'accessing' stamp: ''! firstLineLength ^firstLineLength isNil ifTrue: [codeStream position] ifFalse: [firstLineLength]! ! !RBFormatter methodsFor: 'accessing' stamp: ''! format: aNode self visitNode: aNode. ^codeStream contents! ! !RBFormatter methodsFor: 'private-formatting' stamp: 'md 2/26/2006 15:03'! formatLiteral: aValue | isArray | (isArray := aValue class == Array) | (aValue class == ByteArray) ifTrue: [codeStream nextPutAll: (isArray ifTrue: ['#('] ifFalse: ['#[']). self maybeJoinLinesFrom: [self indent: 1 while: [aValue do: [:each | self indent; formatLiteral: each]]. self indent. codeStream nextPut: (isArray ifTrue: [$)] ifFalse: [$]])]. ^self]. aValue isSymbol ifTrue: [self formatSymbol: aValue. ^self]. aValue class == Character ifTrue: [codeStream nextPut: $$; nextPut: aValue. ^self]. aValue isVariableBinding ifTrue: [ codeStream nextPutAll: '##'; nextPutAll: aValue key. ^ self]. aValue storeOn: codeStream! ! !RBFormatter methodsFor: 'private-formatting' stamp: 'ajh 3/19/2003 16:03'! formatMessage: aMessageNode cascade: cascadeBoolean | selectorParts arguments multiLine formattedArgs indentFirst firstArgLength length start needsPos argStarts | selectorParts := aMessageNode selectorParts. needsPos := selectorParts first start isNil. arguments := aMessageNode arguments. formattedArgs := OrderedCollection new. multiLine := aMessageNode selector numArgs > self maximumArgumentsPerLine. length := aMessageNode selector size + arguments size + 1. firstArgLength := 0. start := self fullPosition. self indentWhile: [1 to: arguments size do: [:i | | formatter string | formatter := (self copy) lineStart: (selectorParts at: i) length negated; yourself. string := formatter format: (arguments at: i). formattedArgs add: string. i == 1 ifTrue: [firstArgLength := formatter firstLineLength]. length := length + string size. multiLine := multiLine or: [formatter isMultiLine]]]. multiLine := multiLine or: [length + self lineLength > self maxLineSize]. indentFirst := cascadeBoolean not and: [multiLine and: [(self startMessageSendOnNewLine: aMessageNode) or: [self lineLength + selectorParts first length + 2 + firstArgLength > self maxLineSize]]]. indentFirst ifTrue: [self indent]. argStarts := self formatMessageSelector: selectorParts withArguments: formattedArgs multiline: multiLine. needsPos ifTrue: [ arguments with: argStarts do: [:node :pos | node adjustPositionsAfter: start by: pos - start]. ]. ! ! !RBFormatter methodsFor: 'private-formatting' stamp: 'md 2/26/2006 15:19'! formatMessageSelector: selectorParts withArguments: formattedArgs multiline: multiLine | selectorPart argStarts | argStarts := Array new: formattedArgs size. formattedArgs isEmpty ifTrue: [ selectorParts first start ifNil: [ selectorParts first start: self fullPosition + 1]. codeStream nextPutAll: selectorParts first value] ifFalse: [1 to: formattedArgs size do: [:i | i ~~ 1 & multiLine not ifTrue: [codeStream nextPut: $ ]. selectorPart := selectorParts at: i. selectorPart start ifNil: [selectorPart start: self fullPosition + 1]. self formatMessageSelectorPart: selectorPart. codeStream nextPut: $ . argStarts at: i put: self fullPosition. codeStream nextPutAll: (formattedArgs at: i). (multiLine and: [i < formattedArgs size]) ifTrue: [self indent]]]. ^ argStarts! ! !RBFormatter methodsFor: 'private-formatting' stamp: 'nk 1/29/2005 11:22'! formatMessageSelectorPart: part codeStream nextPutAll: part value. ! ! !RBFormatter methodsFor: 'private-formatting' stamp: ''! formatMethodCommentFor: aNode indentBefore: aBoolean | source | source := aNode source. source isNil ifTrue: [^self]. aNode comments do: [:each | aBoolean ifTrue: [self indent]. codeStream nextPutAll: (aNode source copyFrom: each first to: each last); cr. aBoolean ifFalse: [self indent]]! ! !RBFormatter methodsFor: 'private-formatting' stamp: 'md 8/5/2005 11:08'! formatMethodPatternFor: aMethodNode | selectorParts arguments | selectorParts := aMethodNode selectorParts. arguments := aMethodNode arguments. arguments isEmpty ifTrue: [ selectorParts first start ifNil: [selectorParts first start: self fullPosition + 1]. codeStream nextPutAll: selectorParts first value] ifFalse: [selectorParts with: arguments do: [:selector :arg | selector start ifNil: [selector start: self fullPosition + 1]. codeStream nextPutAll: selector value; nextPut: $ . self visitMethodArgument: arg. codeStream nextPut: $ ]]! ! !RBFormatter methodsFor: 'private-formatting' stamp: 'ms 9/4/2006 22:49'! formatPragmasFor: aNode aNode pragmas do: [ : each | self indent. self visitNode: each ]! ! !RBFormatter methodsFor: 'private-formatting' stamp: ''! formatStatementCommentFor: aNode | source | source := aNode source. source isNil ifTrue: [^self]. aNode comments do: [:each | | crs | crs := self newLinesFor: source startingAt: each first. (crs - 1 max: 0) timesRepeat: [codeStream cr]. crs == 0 ifTrue: [codeStream tab] ifFalse: [self indent]. codeStream nextPutAll: (source copyFrom: each first to: each last)]! ! !RBFormatter methodsFor: 'private-formatting' stamp: ''! formatStatementsFor: aSequenceNode | statements | statements := aSequenceNode statements. statements isEmpty ifTrue: [^self]. 1 to: statements size - 1 do: [:i | self visitNode: (statements at: i). codeStream nextPut: $.. self formatStatementCommentFor: (statements at: i). self indent]. self visitNode: statements last. self formatStatementCommentFor: statements last! ! !RBFormatter methodsFor: 'private-formatting' stamp: 'md 8/26/2004 18:34'! formatSymbol: aSymbol "Format the symbol, if its not a selector then we must put quotes around it. The and: case below, handles the VisualWorks problem of not accepting two bars as a symbol." codeStream nextPut: $#. ((Scanner isLiteralSymbol: aSymbol) and: [aSymbol ~~ #'||']) ifTrue: [codeStream nextPutAll: aSymbol] ifFalse: [aSymbol asString printOn: codeStream] " ((RBScanner isSelector: aSymbol) and: [aSymbol ~~ #'||']) ifTrue: [codeStream nextPutAll: aSymbol] ifFalse: [aSymbol asString printOn: codeStream]"! ! !RBFormatter methodsFor: 'private-formatting' stamp: ''! formatTagFor: aMethodNode | primitiveSources | primitiveSources := aMethodNode primitiveSources. primitiveSources do: [:each | codeStream nextPutAll: each. self indent]! ! !RBFormatter methodsFor: 'private-formatting' stamp: 'nk 1/29/2005 11:30'! formatTemporariesFor: aSequenceNode | temps | temps := aSequenceNode temporaries. temps isEmpty ifTrue: [^self]. codeStream nextPutAll: '| '. temps do: [:each | self visitTemporaryVariable: each. codeStream nextPut: $ ]. codeStream nextPut: $|. self indent! ! !RBFormatter methodsFor: 'position fill' stamp: 'ajh 3/19/2003 14:12'! fullPosition ^ positionDelta + codeStream position! ! !RBFormatter methodsFor: 'private' stamp: ''! indent firstLineLength isNil ifTrue: [firstLineLength := codeStream position]. codeStream cr. tabs timesRepeat: [codeStream tab]. lineStart := codeStream position! ! !RBFormatter methodsFor: 'private' stamp: ''! indent: anInteger while: aBlock tabs := tabs + anInteger. aBlock value. tabs := tabs - anInteger! ! !RBFormatter methodsFor: 'private' stamp: ''! indentWhile: aBlock self indent: 1 while: aBlock! ! !RBFormatter methodsFor: 'initialize-release' stamp: 'md 2/26/2006 15:01'! initialize super initialize. codeStream := WriteStream on: (String new: 60). tabs := 0. lineStart := 0. positionDelta := 0. ! ! !RBFormatter methodsFor: 'accessing' stamp: ''! isMultiLine ^firstLineLength notNil! ! !RBFormatter methodsFor: 'accessing' stamp: ''! lastLineLength ^codeStream position - (lineStart max: 0)! ! !RBFormatter methodsFor: 'private' stamp: ''! lineLength ^codeStream position - lineStart! ! !RBFormatter methodsFor: 'private' stamp: ''! lineStart: aPosition lineStart := aPosition! ! !RBFormatter methodsFor: 'private' stamp: ''! maxLineSize ^75! ! !RBFormatter methodsFor: 'private' stamp: ''! maximumArgumentsPerLine ^2! ! !RBFormatter methodsFor: 'private-formatting' stamp: 'apl 3/26/2005 14:51'! maybeJoinLinesFrom: aBlock | statementBegin statementEnd statementText statementLines initialLineLength | initialLineLength := self lineLength. statementBegin := codeStream position. aBlock value. statementEnd := codeStream position. statementText := codeStream contents copyFrom: statementBegin + 1 to: statementEnd. initialLineLength + statementText size < self maxLineSize ifTrue: [statementLines := statementText asString findTokens: String cr , String tab. codeStream position: statementBegin. statementLines do: [:line | codeStream nextPutAll: line] separatedBy: [codeStream space]]! ! !RBFormatter methodsFor: 'private' stamp: ''! needsParenthesisFor: aNode | parent grandparent | aNode isValue ifFalse: [^false]. parent := aNode parent. parent isNil ifTrue: [^false]. (aNode isMessage and: [parent isMessage and: [parent receiver == aNode]]) ifTrue: [grandparent := parent parent. (grandparent notNil and: [grandparent isCascade]) ifTrue: [^true]]. aNode precedence < parent precedence ifTrue: [^false]. aNode isAssignment & parent isAssignment ifTrue: [^false]. aNode isAssignment | aNode isCascade ifTrue: [^true]. aNode precedence == 0 ifTrue: [^false]. aNode isMessage ifFalse: [^true]. aNode precedence = parent precedence ifFalse: [^true]. aNode isUnary ifTrue: [^false]. aNode isKeyword ifTrue: [^true]. parent receiver == aNode ifFalse: [^true]. ^self precedenceOf: parent selector greaterThan: aNode selector! ! !RBFormatter methodsFor: 'private-formatting' stamp: ''! newLinesFor: aString startingAt: anIndex | count cr lf index char | cr := Character value: 13. lf := Character value: 10. count := 0. index := anIndex - 1. [index > 0 and: [char := aString at: index. char isSeparator]] whileTrue: [char == lf ifTrue: [count := count + 1. (aString at: (index - 1 max: 1)) == cr ifTrue: [index := index - 1]]. char == cr ifTrue: [count := count + 1]. index := index - 1]. ^count! ! !RBFormatter methodsFor: 'copying' stamp: 'pmm 2/24/2006 11:01'! postCopy super postCopy. positionDelta := positionDelta + codeStream position. lineStart := self lineLength negated. codeStream := (codeStream ifNil: [ WriteStream on: (String new: 60) ] ifNotNil: [ codeStream class on: (codeStream contents class new: 60) ]). firstLineLength := nil! ! !RBFormatter methodsFor: 'private' stamp: ''! precedenceOf: parentSelector greaterThan: childSelector "Put parenthesis around things that are preceived to have 'lower' precedence. For example, 'a + b * c' -> '(a + b) * c' but 'a * b + c' -> 'a * b + c'" | childIndex parentIndex operators | operators := #(#($| $& $?) #($= $~ $< $>) #($- $+) #($* $/ $% $\) #($@)). childIndex := 0. parentIndex := 0. 1 to: operators size do: [:i | ((operators at: i) includes: parentSelector first) ifTrue: [parentIndex := i]. ((operators at: i) includes: childSelector first) ifTrue: [childIndex := i]]. ^childIndex < parentIndex! ! !RBFormatter methodsFor: 'private' stamp: ''! selectorsToLeaveOnLine ^#(#to:do: #to:by: #to:by:do:)! ! !RBFormatter methodsFor: 'private' stamp: ''! selectorsToStartOnNewLine ^#(#ifTrue:ifFalse: #ifFalse:ifTrue: #ifTrue: #ifFalse:)! ! !RBFormatter methodsFor: 'testing' stamp: ''! startMessageSendOnNewLine: aMessageNode (self selectorsToStartOnNewLine includes: aMessageNode selector) ifTrue: [^true]. (self selectorsToLeaveOnLine includes: aMessageNode selector) ifTrue: [^false]. ^aMessageNode selector numArgs > self maximumArgumentsPerLine! ! !RBFormatter methodsFor: 'testing' stamp: 'md 2/26/2006 15:00'! tagBeforeTemporaries ^false! ! !RBFormatter methodsFor: 'visiting' stamp: ''! visitNode: aNode | parenthesis | parenthesis := self needsParenthesisFor: aNode. parenthesis ifTrue: [codeStream nextPut: $(]. aNode acceptVisitor: self. parenthesis ifTrue: [codeStream nextPut: $)]! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'ls 1/24/2000 00:31'! acceptArrayNode: anArrayNode anArrayNode children do: [:each | self visitNode: each]! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: ''! acceptAssignmentNode: anAssignmentNode self visitNode: anAssignmentNode variable. self visitNode: anAssignmentNode value! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'nk 1/29/2005 11:10'! acceptBlockNode: aBlockNode self visitBlockArguments: aBlockNode arguments. self visitNode: aBlockNode body! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: ''! acceptCascadeNode: aCascadeNode aCascadeNode messages do: [:each | self visitNode: each]! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'ajh 2/26/2003 18:34'! acceptDoItNode: aDoItNode self visitNode: aDoItNode body! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: ''! acceptLiteralNode: aLiteralNode! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: ''! acceptMessageNode: aMessageNode (aMessageNode isCascaded not or: [aMessageNode isFirstCascaded]) ifTrue: [self visitNode: aMessageNode receiver]. aMessageNode arguments do: [:each | self visitNode: each]! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'ms 9/19/2006 14:45'! acceptMethodNode: aMethodNode self visitMethodArguments: aMethodNode arguments. aMethodNode pragmas do: [:each | self visitNode: each]. self visitNode: aMethodNode body! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'ms 9/4/2006 00:06'! acceptPragmaNode: aPragmaNode! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'ajh 3/3/2003 12:43'! acceptPseudoNode: aVariableNode! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: ''! acceptReturnNode: aReturnNode self visitNode: aReturnNode value! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'nk 1/29/2005 11:08'! acceptSequenceNode: aSequenceNode self visitTemporaryVariables: aSequenceNode temporaries. aSequenceNode statements do: [:each | self visitNode: each]! ! !RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: ''! acceptVariableNode: aVariableNode! ! !RBProgramNodeVisitor methodsFor: 'copying' stamp: ''! postCopy! ! !RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''! visitArgument: each "Here to allow subclasses to detect arguments or temporaries." ^self visitNode: each! ! !RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''! visitArguments: aNodeCollection ^aNodeCollection do: [:each | self visitArgument: each]! ! !RBProgramNodeVisitor methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:10'! visitBlockArgument: each "Here to allow subclasses to detect arguments or temporaries." ^self visitArgument: each! ! !RBProgramNodeVisitor methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:09'! visitBlockArguments: aNodeCollection ^aNodeCollection do: [:each | self visitBlockArgument: each]! ! !RBProgramNodeVisitor methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:09'! visitMethodArgument: each "Here to allow subclasses to detect arguments or temporaries." ^self visitArgument: each! ! !RBProgramNodeVisitor methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:09'! visitMethodArguments: aNodeCollection ^aNodeCollection do: [:each | self visitMethodArgument: each]! ! !RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''! visitNode: aNode ^aNode acceptVisitor: self! ! !RBProgramNodeVisitor methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:14'! visitTemporaryVariable: aNode ^self visitArgument: aNode! ! !RBProgramNodeVisitor methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:07'! visitTemporaryVariables: aNodeCollection ^aNodeCollection do: [:each | self visitTemporaryVariable: each]! ! RBProgramNodeVisitor subclass: #RBReadBeforeWrittenTester instanceVariableNames: 'read checkNewTemps scopeStack' classVariableNames: '' poolDictionaries: '' category: 'AST-ParseTree Matching'! !RBReadBeforeWrittenTester class methodsFor: 'accessing' stamp: 'bh 3/15/2000 16:48'! isVariable: aString readBeforeWrittenIn: aBRProgramNode ^(self isVariable: aString writtenBeforeReadIn: aBRProgramNode) not! ! !RBReadBeforeWrittenTester class methodsFor: 'accessing' stamp: 'bh 3/15/2000 16:49'! isVariable: aString writtenBeforeReadIn: aBRProgramNode ^(self readBeforeWritten: (Array with: aString) in: aBRProgramNode) isEmpty! ! !RBReadBeforeWrittenTester class methodsFor: 'accessing' stamp: 'bh 3/15/2000 16:49'! readBeforeWritten: varNames in: aParseTree ^(self new) checkNewTemps: false; initializeVars: varNames; executeTree: aParseTree; read! ! !RBReadBeforeWrittenTester class methodsFor: 'accessing' stamp: 'bh 3/15/2000 16:49'! variablesReadBeforeWrittenIn: aParseTree ^(self new) executeTree: aParseTree; read! ! !RBReadBeforeWrittenTester methodsFor: 'visitor-double dispatching' stamp: 'bh 3/15/2000 16:45'! acceptAssignmentNode: anAssignmentNode self visitNode: anAssignmentNode value. self variableWritten: anAssignmentNode! ! !RBReadBeforeWrittenTester methodsFor: 'visitor-double dispatching' stamp: 'bh 3/15/2000 16:46'! acceptBlockNode: aBlockNode self processBlock: aBlockNode.! ! !RBReadBeforeWrittenTester methodsFor: 'visitor-double dispatching' stamp: 'pmm 7/12/2006 15:51'! acceptMessageNode: aMessageNode ((#(#whileTrue: #whileFalse: #whileTrue #whileFalse) includes: aMessageNode selector) and: [aMessageNode receiver isBlock]) ifTrue: [self executeTree: aMessageNode receiver body] ifFalse: [(aMessageNode isCascaded not or: [aMessageNode isFirstCascaded]) ifTrue: [self visitNode: aMessageNode receiver]]. ((#(#ifTrue:ifFalse: #ifFalse:ifTrue:) includes: aMessageNode selector) and: [ aMessageNode arguments allSatisfy: [:each | each isBlock] ]) ifTrue: [^self processIfTrueIfFalse: aMessageNode]. aMessageNode arguments do: [:each | self visitNode: each]! ! !RBReadBeforeWrittenTester methodsFor: 'visitor-double dispatching' stamp: 'bh 3/15/2000 16:46'! acceptSequenceNode: aSequenceNode self processStatementNode: aSequenceNode! ! !RBReadBeforeWrittenTester methodsFor: 'visitor-double dispatching' stamp: 'bh 3/15/2000 16:47'! acceptVariableNode: aVariableNode self variableRead: aVariableNode! ! !RBReadBeforeWrittenTester methodsFor: 'initialize-release' stamp: ''! checkNewTemps: aBoolean checkNewTemps := aBoolean! ! !RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'bh 3/15/2000 16:40'! copyDictionary: aDictionary "We could send aDictionary the copy message, but that doesn't copy the associations." | newDictionary | newDictionary := Dictionary new: aDictionary size. aDictionary keysAndValuesDo: [:key :value | newDictionary at: key put: value]. ^newDictionary! ! !RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''! createScope scopeStack add: (self copyDictionary: scopeStack last)! ! !RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''! currentScope ^scopeStack last! ! !RBReadBeforeWrittenTester methodsFor: 'accessing' stamp: 'bh 3/15/2000 16:39'! executeTree: aParseTree ^self visitNode: aParseTree! ! !RBReadBeforeWrittenTester methodsFor: 'initialize-release' stamp: 'bh 3/15/2000 16:37'! initialize scopeStack := OrderedCollection with: Dictionary new. read := Set new. checkNewTemps := true. ! ! !RBReadBeforeWrittenTester methodsFor: 'initialize-release' stamp: ''! initializeVars: varNames varNames do: [:each | self currentScope at: each put: nil]! ! !RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'bh 3/15/2000 16:41'! processBlock: aNode | newScope | self createScope. self executeTree: aNode body. newScope := self removeScope. newScope keysAndValuesDo: [:key :value | (value == true and: [(self currentScope at: key) isNil]) ifTrue: [self currentScope at: key put: value]]! ! !RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'bh 3/15/2000 16:42'! processIfTrueIfFalse: aNode | trueScope falseScope | self createScope. self executeTree: aNode arguments first body. trueScope := self removeScope. self createScope. self executeTree: aNode arguments last body. falseScope := self removeScope. self currentScope keysAndValuesDo: [:key :value | value isNil ifTrue: [(trueScope at: key) == (falseScope at: key) ifTrue: [self currentScope at: key put: (trueScope at: key)] ifFalse: [((trueScope at: key) == true or: [(falseScope at: key) == true]) ifTrue: [self currentScope at: key put: true]]]]! ! !RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'bh 3/15/2000 16:42'! processStatementNode: aNode | temps | (checkNewTemps not or: [aNode temporaries isEmpty]) ifTrue: [aNode statements do: [:each | self executeTree: each]. ^self]. self createScope. temps := aNode temporaries collect: [:each | each name]. self initializeVars: temps. aNode statements do: [:each | self executeTree: each]. self removeScope keysAndValuesDo: [:key :value | (temps includes: key) ifTrue: [value == true ifTrue: [read add: key]] ifFalse: [(self currentScope at: key) isNil ifTrue: [self currentScope at: key put: value]]]! ! !RBReadBeforeWrittenTester methodsFor: 'accessing' stamp: 'bh 3/15/2000 16:39'! read self currentScope keysAndValuesDo: [:key :value | value == true ifTrue: [read add: key]]. ^read! ! !RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''! removeScope ^scopeStack removeLast! ! !RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'bh 3/15/2000 16:44'! variableRead: aNode (self currentScope includesKey: aNode name) ifTrue: [(self currentScope at: aNode name) isNil ifTrue: [self currentScope at: aNode name put: true]]! ! !RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'bh 3/15/2000 16:45'! variableWritten: aNode (self currentScope includesKey: aNode variable name) ifTrue: [(self currentScope at: aNode variable name) isNil ifTrue: [self currentScope at: aNode variable name put: false]]! ! Object subclass: #RBToken instanceVariableNames: 'sourcePointer next previous' classVariableNames: '' poolDictionaries: '' category: 'AST-Tokens'! !RBToken commentStamp: 'md 8/9/2005 14:53' prior: 0! RBToken is the abstract superclass of all of the RB tokens. These tokens (unlike the standard parser's) remember where they came from in the original source code. Subclasses must implement the following messages: accessing length Instance Variables: sourcePointer The position in the original source code where this token began. ! RBToken subclass: #RBAssignmentToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tokens'! !RBAssignmentToken commentStamp: 'md 8/9/2005 14:51' prior: 0! RBAssignmentToken is the first-class representation of the assignment token ':=' ! !RBAssignmentToken methodsFor: 'testing' stamp: ''! isAssignment ^true! ! !RBAssignmentToken methodsFor: 'private' stamp: 'ls 1/11/2000 07:00'! length ^2! ! RBAssignmentToken subclass: #RBShortAssignmentToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tokens'! !RBShortAssignmentToken methodsFor: 'private' stamp: 'ls 1/11/2000 07:00'! length ^1! ! !RBToken class methodsFor: 'instance creation' stamp: ''! start: anInterval ^self new start: anInterval! ! !RBToken methodsFor: 'testing' stamp: ''! isAssignment ^false! ! !RBToken methodsFor: 'testing' stamp: ''! isBinary ^false! ! !RBToken methodsFor: 'testing' stamp: ''! isIdentifier ^false! ! !RBToken methodsFor: 'testing' stamp: ''! isKeyword ^false! ! !RBToken methodsFor: 'testing' stamp: ''! isLiteral ^false! ! !RBToken methodsFor: 'testing' stamp: ''! isPatternBlock ^false! ! !RBToken methodsFor: 'testing' stamp: ''! isPatternVariable ^false! ! !RBToken methodsFor: 'testing' stamp: 'md 9/1/2005 16:02'! isRBToken ^true.! ! !RBToken methodsFor: 'testing' stamp: ''! isSpecial ^false! ! !RBToken methodsFor: 'accessing' stamp: ''! length ^self subclassResponsibility! ! !RBToken methodsFor: 'accessing' stamp: 'ms 9/17/2006 02:05'! next ^next! ! !RBToken methodsFor: 'accessing' stamp: 'ms 9/17/2006 02:05'! next: aToken next := aToken! ! !RBToken methodsFor: 'accessing' stamp: 'ms 9/17/2006 02:04'! previous ^previous! ! !RBToken methodsFor: 'accessing' stamp: 'ms 9/17/2006 02:05'! previous: aToken aToken ifNotNil:[aToken next: self]. previous := aToken! ! !RBToken methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPut: $ ; nextPutAll: self class name! ! !RBToken methodsFor: 'accessing' stamp: ''! removePositions sourcePointer := nil! ! !RBToken methodsFor: 'accessing' stamp: ''! start ^sourcePointer! ! !RBToken methodsFor: 'initialize-release' stamp: ''! start: anInteger sourcePointer := anInteger! ! !RBToken methodsFor: 'accessing' stamp: 'lr 6/8/2007 16:49'! stop ^ (self start ifNil: [0]) + self length - 1! ! RBToken subclass: #RBValueToken instanceVariableNames: 'value' classVariableNames: '' poolDictionaries: '' category: 'AST-Tokens'! !RBValueToken commentStamp: 'md 8/9/2005 14:53' prior: 0! RBValueToken is the abstract superclass of all tokens that have additional information attached. For example, the BinarySelector token holds onto the actual character (e.g. $+). Instance Variables: value The value of this token! RBValueToken subclass: #RBBinarySelectorToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tokens'! !RBBinarySelectorToken commentStamp: 'md 8/9/2005 14:51' prior: 0! RBBinarySelectorToken is the first-class representation of a binary selector (e.g. +) ! !RBBinarySelectorToken methodsFor: 'testing' stamp: ''! isBinary ^true! ! RBValueToken subclass: #RBIdentifierToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tokens'! !RBIdentifierToken commentStamp: 'md 8/9/2005 14:51' prior: 0! RBIdentifierToken is the first class representation of an identifier token (e.g. Class) ! !RBIdentifierToken methodsFor: 'testing' stamp: ''! isIdentifier ^true! ! !RBIdentifierToken methodsFor: 'testing' stamp: 'md 8/26/2004 18:36'! isPatternVariable ^value first == $`. "value first == RBScanner patternVariableCharacter"! ! RBValueToken subclass: #RBKeywordToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tokens'! !RBKeywordToken commentStamp: 'md 8/9/2005 14:52' prior: 0! RBKeywordToken is the first-class representation of a keyword token (e.g. add:)! !RBKeywordToken methodsFor: 'testing' stamp: ''! isKeyword ^true! ! !RBKeywordToken methodsFor: 'testing' stamp: 'md 8/26/2004 18:37'! isPatternVariable ^value first == $`. "value first == RBScanner patternVariableCharacter"! ! RBValueToken subclass: #RBLiteralToken instanceVariableNames: 'stopPosition' classVariableNames: '' poolDictionaries: '' category: 'AST-Tokens'! !RBLiteralToken commentStamp: 'md 8/9/2005 14:52' prior: 0! RBLiteralToken is the first-class representation of a literal token (entire literals, even literal arrays, are a single token in the ST80 grammar.). Instance Variables: stopPosition The position within the source code where the token terminates. ! !RBLiteralToken class methodsFor: 'instance creation' stamp: ''! value: anObject | literal | literal := anObject class == Array ifTrue: [anObject collect: [:each | self value: each]] ifFalse: [anObject]. ^self value: literal start: nil stop: nil! ! !RBLiteralToken class methodsFor: 'instance creation' stamp: ''! value: aString start: anInteger stop: stopInteger ^self new value: aString start: anInteger stop: stopInteger! ! !RBLiteralToken methodsFor: 'testing' stamp: ''! isLiteral ^true! ! !RBLiteralToken methodsFor: 'private' stamp: ''! length ^stopPosition - self start + 1! ! !RBLiteralToken methodsFor: 'accessing' stamp: ''! stop: anObject stopPosition := anObject! ! !RBLiteralToken methodsFor: 'initialize-release' stamp: ''! value: aString start: anInteger stop: stopInteger value := aString. sourcePointer := anInteger. stopPosition := stopInteger! ! RBValueToken subclass: #RBPatternBlockToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tokens'! !RBPatternBlockToken commentStamp: 'md 8/9/2005 14:52' prior: 0! RBPatternBlockToken is the first-class representation of the pattern block token. ! !RBPatternBlockToken methodsFor: 'testing' stamp: ''! isPatternBlock ^true! ! RBValueToken subclass: #RBSpecialCharacterToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-Tokens'! !RBSpecialCharacterToken commentStamp: 'md 8/9/2005 14:53' prior: 0! RBSpecialCharacterToken is the first class representation of special characters. ! !RBSpecialCharacterToken methodsFor: 'testing' stamp: ''! isSpecial ^true! ! !RBSpecialCharacterToken methodsFor: 'private' stamp: 'md 8/30/2006 17:21'! length ^1! ! !RBValueToken class methodsFor: 'instance creation' stamp: ''! value: aString start: anInteger ^self new value: aString start: anInteger! ! !RBValueToken methodsFor: 'private' stamp: ''! length ^value size! ! !RBValueToken methodsFor: 'printing' stamp: ''! printOn: aStream super printOn: aStream. aStream nextPut: $(. value printOn: aStream. aStream nextPutAll: ')'! ! !RBValueToken methodsFor: 'accessing' stamp: 'pmm 7/31/2006 11:32'! realValue ^value class == Array ifTrue: [value collect: [:each | each realValue]] ifFalse: [value]! ! !RBValueToken methodsFor: 'accessing' stamp: ''! value ^value! ! !RBValueToken methodsFor: 'accessing' stamp: ''! value: anObject value := anObject! ! !RBValueToken methodsFor: 'initialize-release' stamp: ''! value: aString start: anInteger value := aString. sourcePointer := anInteger! ! !TPureBehavior methodsFor: '*ast' stamp: 'md 4/16/2007 10:41'! parseTreeFor: aSymbol self flag: #FIXME. "UGLY hack for beeing able to share AST package with Persephone... this needs to be fixed later". Smalltalk at: #ReflectiveMethod ifPresent: [:cls | | method | method := self compiledMethodAt: aSymbol. method hasReflectiveMethod ifTrue: [^method reflectiveMethod methodNode]. ]. ^RBParser parseMethod: (self sourceCodeAt: aSymbol) onError: [:aString :pos | ^nil]! ! !Behavior methodsFor: '*ast-override' stamp: 'md 7/13/2006 15:56'! formatterClass ^Preferences useRBASTForPrettyPrint ifFalse: [ self compilerClass ] ifTrue: [ RBParser ]! ! !Behavior methodsFor: '*ast-override' stamp: 'md 7/13/2006 15:56'! prettyPrinterClass ^Preferences useRBASTForPrettyPrint ifFalse: [ self compilerClass ] ifTrue: [ RBParser ]! ! Stream subclass: #RBScanner instanceVariableNames: 'stream buffer tokenStart currentCharacter characterType classificationTable numberType separatorsInLiterals extendedLiterals extendedSymbols comments extendedLanguage errorBlock nameSpaceCharacter' classVariableNames: 'ClassificationTable PatternVariableCharacter' poolDictionaries: '' category: 'AST-RBParser'! !RBScanner commentStamp: 'md 8/9/2005 14:54' prior: 0! RBScanner is a stream that returns a sequence of token from the string that it is created on. The tokens know where they came from in the source code and which comments were attached to them. Instance Variables: buffer Accumulates the text for the current token. characterType The type of the next character. (e.g. #alphabetic, etc.) classificationTable Mapping from Character values to their characterType. comments Source intervals of scanned comments that must be attached to the next token. currentCharacter The character currently being processed. errorBlock The block to execute on lexical errors. extendedLiterals True if IBM-type literals are allowed. In VW, this is false. nameSpaceCharacter The character used to separate namespaces. numberType The method to perform: to scan a number. separatorsInLiterals True if separators are allowed within literals. stream Contains the text to be scanned. tokenStart The source position of the beginning of the current token Class Instance Variables: classificationTable the default classification table for all characters Shared Variables: PatternVariableCharacter the character that starts a pattern node! !RBScanner class methodsFor: 'accessing' stamp: ''! classificationTable ClassificationTable isNil ifTrue: [self initialize]. ^ClassificationTable! ! !RBScanner class methodsFor: 'class initialization' stamp: 'ls 3/20/2004 14:17'! initialize PatternVariableCharacter := $`. ClassificationTable := Array new: 255. self initializeChars: 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ' to: #alphabetic. self initializeChars: (128 to: 255) asByteArray asString to: #alphabetic. self initializeChars: '01234567890' to: #digit. self initializeChars: '!!!!%&*+,-/<=>?@\~|' to: #binary. ClassificationTable at: 177 put: #binary. "plus-or-minus" ClassificationTable at: 183 put: #binary. "centered dot" ClassificationTable at: 215 put: #binary. "times" ClassificationTable at: 247 put: #binary. "divide" self initializeChars: '().:;[]^{}_' to: #special. #(9 10 12 13 26 32) do: [:i | ClassificationTable at: i put: #separator]! ! !RBScanner class methodsFor: 'class initialization' stamp: ''! initializeChars: characters to: aSymbol characters do: [:c | ClassificationTable at: c asInteger put: aSymbol]! ! !RBScanner class methodsFor: 'testing' stamp: ''! isSelector: aSymbol | scanner token | scanner := self basicNew. scanner on: (ReadStream on: aSymbol asString). scanner step. token := scanner scanAnySymbol. token isLiteral ifFalse: [^false]. token value isEmpty ifTrue: [^false]. ^scanner atEnd! ! !RBScanner class methodsFor: 'testing' stamp: ''! isVariable: aString | scanner token | aString isString ifFalse: [^false]. aString isEmpty ifTrue: [^false]. (ClassificationTable at: aString first asInteger) == #alphabetic ifFalse: [^false]. scanner := self basicNew. scanner on: (ReadStream on: aString asString). scanner errorBlock: [:s :p | ^false]. scanner step. token := scanner scanIdentifierOrKeyword. token isKeyword ifTrue: [^false]. ^scanner atEnd! ! !RBScanner class methodsFor: 'instance creation' stamp: ''! on: aStream | str | str := self basicNew on: aStream. str step; stripSeparators. ^str! ! !RBScanner class methodsFor: 'instance creation' stamp: ''! on: aStream errorBlock: aBlock | str | str := self basicNew on: aStream. str errorBlock: aBlock; step; stripSeparators. ^str! ! !RBScanner class methodsFor: 'accessing' stamp: ''! patternVariableCharacter ^PatternVariableCharacter! ! !RBScanner class methodsFor: 'instance creation' stamp: ''! rewriteOn: aStream | str | str := self basicNew on: aStream. str extendedLanguage: true; step; stripSeparators. ^str! ! !RBScanner class methodsFor: 'instance creation' stamp: ''! rewriteOn: aStream errorBlock: aBlock | str | str := self basicNew on: aStream. str extendedLanguage: true; errorBlock: aBlock; step; stripSeparators. ^str! ! !RBScanner methodsFor: 'testing' stamp: ''! atEnd ^characterType == #eof! ! !RBScanner methodsFor: 'accessing' stamp: ''! classificationTable: anObject classificationTable := anObject! ! !RBScanner methodsFor: 'private' stamp: ''! classify: aCharacter | index | aCharacter isNil ifTrue: [^nil]. index := aCharacter asInteger. index == 0 ifTrue: [^#separator]. index > 255 ifTrue: [^nil]. ^classificationTable at: index! ! !RBScanner methodsFor: 'accessing' stamp: ''! contents | contentsStream | contentsStream := WriteStream on: (Array new: 50). self do: [:each | contentsStream nextPut: each]. ^contentsStream contents! ! !RBScanner methodsFor: 'error handling' stamp: ''! errorBlock ^errorBlock isNil ifTrue: [[:message :position | ]] ifFalse: [errorBlock]! ! !RBScanner methodsFor: 'accessing' stamp: ''! errorBlock: aBlock errorBlock := aBlock! ! !RBScanner methodsFor: 'error handling' stamp: ''! errorPosition ^stream position! ! !RBScanner methodsFor: 'accessing' stamp: ''! extendedLanguage ^extendedLanguage! ! !RBScanner methodsFor: 'accessing' stamp: ''! extendedLanguage: aBoolean extendedLanguage := aBoolean! ! !RBScanner methodsFor: 'accessing' stamp: ''! flush! ! !RBScanner methodsFor: 'accessing' stamp: ''! getComments | oldComments | comments isEmpty ifTrue: [^nil]. oldComments := comments. comments := OrderedCollection new: 1. ^oldComments! ! !RBScanner methodsFor: 'initialize-release' stamp: 'ls 1/30/2000 19:14'! initializeForSqueak numberType := #scanNumberIBM. separatorsInLiterals := true. extendedLiterals := true. extendedSymbols := true. nameSpaceCharacter := nil.! ! !RBScanner methodsFor: 'testing' stamp: ''! isReadable ^true! ! !RBScanner methodsFor: 'testing' stamp: ''! isWritable ^false! ! !RBScanner methodsFor: 'accessing' stamp: ''! next | token | buffer reset. tokenStart := stream position. characterType == #eof ifTrue: [^RBToken start: tokenStart + 1]. "The EOF token should occur after the end of input" token := self scanToken. self stripSeparators. ^token! ! !RBScanner methodsFor: 'accessing' stamp: ''! nextPut: anObject "Provide an error notification that the receiver does not implement this message." self shouldNotImplement! ! !RBScanner methodsFor: 'initialize-release' stamp: 'md 10/11/2005 15:49'! on: aStream buffer := WriteStream on: (String new: 60). stream := aStream. classificationTable := self class classificationTable. extendedLanguage := false. comments := OrderedCollection new. self initializeForSqueak.! ! !RBScanner methodsFor: 'private' stamp: ''! previousStepPosition ^characterType == #eof ifTrue: [stream position] ifFalse: [stream position - 1]! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanAnySymbol characterType == #alphabetic ifTrue: [^self scanSymbol]. characterType == #binary ifTrue: [^self scanBinary: RBLiteralToken]. ^RBToken new! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanBinary: aClass "This doesn't parse according to the ANSI draft. It only parses 1 or 2 letter binary tokens." | val | buffer nextPut: currentCharacter. self step. (characterType == #binary and: [currentCharacter ~~ $-]) ifTrue: [buffer nextPut: currentCharacter. self step]. val := buffer contents. val := val asSymbol. ^aClass value: val start: tokenStart! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanByteArray | byteStream number | byteStream := WriteStream on: (ByteArray new: 100). self step. [self stripSeparators. characterType == #digit] whileTrue: [number := self scanNumber value. (number isInteger and: [number between: 0 and: 255]) ifFalse: [self scannerError: 'Expecting 8-bit integer']. byteStream nextPut: number]. currentCharacter == $] ifFalse: [self scannerError: ''']'' expected']. self step. "]" ^RBLiteralToken value: byteStream contents start: tokenStart stop: self previousStepPosition! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanExponentMultipler | exponent isExpNegative position | currentCharacter == $e ifTrue: [position := stream position. self step. (isExpNegative := currentCharacter == $-) ifTrue: [self step]. exponent := self scanNumberOfBase: 10. exponent isNil ifTrue: ["Did not read a valid exponent, e must be start of a message send" stream position: position - 1. self step. exponent := 0] ifFalse: [isExpNegative ifTrue: [exponent := exponent negated]]] ifFalse: [exponent := 0]. ^10 raisedToInteger: exponent! ! !RBScanner methodsFor: 'private-scanning' stamp: 'ls 1/30/2000 19:21'! scanExtendedSymbol "scan symbols like #. which are allowed by Squeak but aren't standard" | token | token := RBLiteralToken value: (currentCharacter asString asSymbol) start: tokenStart stop: stream position. self step. ^token ! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanIdentifierOrKeyword | tokenType token name | self scanName. currentCharacter == nameSpaceCharacter ifTrue: [token := self scanNamespaceName. token notNil ifTrue: [^token]]. (currentCharacter == $: and: [stream peek ~~ $=]) ifTrue: [buffer nextPut: currentCharacter. self step. ":" tokenType := RBKeywordToken] ifFalse: [tokenType := RBIdentifierToken]. name := buffer contents. name = 'true' ifTrue: [^RBLiteralToken value: true start: tokenStart stop: self previousStepPosition]. name = 'false' ifTrue: [^RBLiteralToken value: false start: tokenStart stop: self previousStepPosition]. name = 'nil' ifTrue: [^RBLiteralToken value: nil start: tokenStart stop: self previousStepPosition]. ^tokenType value: name start: tokenStart! ! !RBScanner methodsFor: 'private-scanning' stamp: 'md 4/28/2006 15:02'! scanLiteral self step. separatorsInLiterals ifTrue: [self stripSeparators]. characterType == #alphabetic ifTrue: [^self scanSymbol]. characterType == #binary ifTrue: [^(self scanBinary: RBLiteralToken) stop: self previousStepPosition]. currentCharacter == $' ifTrue: [^self scanStringSymbol]. currentCharacter == $( ifTrue: [^self scanLiteralArray]. currentCharacter == $[ ifTrue: [^self scanByteArray]. (extendedSymbols and: [ '._' includes: currentCharacter ]) ifTrue: [^self scanExtendedSymbol ]. (separatorsInLiterals and: [currentCharacter == ${]) ifTrue: [^self scanQualifier]. self scannerError: 'Expecting a literal type'! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanLiteralArray | arrayStream start | arrayStream := WriteStream on: (Array new: 10). self step. start := tokenStart. [self stripSeparators. tokenStart := stream position. currentCharacter == $)] whileFalse: [arrayStream nextPut: self scanLiteralArrayParts. buffer reset]. self step. ^RBLiteralToken value: arrayStream contents start: start stop: self previousStepPosition! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanLiteralArrayParts currentCharacter == $# ifTrue: [^self scanLiteral]. characterType == #alphabetic ifTrue: [| token value | token := self scanSymbol. value := token value. value == #nil ifTrue: [token value: nil]. value == #true ifTrue: [token value: true]. value == #false ifTrue: [token value: false]. ^token]. (characterType == #digit or: [currentCharacter == $- and: [(self classify: stream peek) == #digit]]) ifTrue: [^self scanNumber]. characterType == #binary ifTrue: [^(self scanBinary: RBLiteralToken) stop: self previousStepPosition]. currentCharacter == $' ifTrue: [^self scanLiteralString]. currentCharacter == $$ ifTrue: [^self scanLiteralCharacter]. currentCharacter == $( ifTrue: [^self scanLiteralArray]. currentCharacter == $[ ifTrue: [^self scanByteArray]. ^self scannerError: 'Unknown character in literal array'! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanLiteralCharacter | token | self step. "$" token := RBLiteralToken value: currentCharacter start: tokenStart stop: stream position. self step. "char" ^token! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanLiteralString self step. [currentCharacter isNil ifTrue: [self scannerError: 'Unmatched '' in string literal.']. currentCharacter == $' and: [self step ~~ $']] whileFalse: [buffer nextPut: currentCharacter. self step]. ^RBLiteralToken value: buffer contents start: tokenStart stop: self previousStepPosition! ! !RBScanner methodsFor: 'private-scanning' stamp: 'pmm 7/12/2006 16:08'! scanName [ #(alphabetic digit) includes: characterType ] whileTrue: [buffer nextPut: currentCharacter. self step]! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanNamespaceName extendedLiterals ifTrue: [stream peek == $: ifFalse: [^nil]. buffer next: 2 put: $:. self step] ifFalse: [(stream atEnd or: [(self classify: stream peek) ~~ #alphabetic]) ifTrue: [^nil]. buffer nextPut: $.]. self step. self scanName. currentCharacter == nameSpaceCharacter ifTrue: [self scanNamespaceName]. ^RBIdentifierToken value: buffer contents start: tokenStart! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanNumber ^RBLiteralToken value: (self perform: numberType) start: tokenStart stop: self previousStepPosition! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanNumberIBM | number isNegative | isNegative := false. currentCharacter == $- ifTrue: [isNegative := true. self step]. number := self scanNumberWithoutExponent. ^(isNegative ifTrue: [number negated] ifFalse: [number]) * self scanExponentMultipler! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanNumberOfBase: anInteger "Scan a number. Return the number or nil if the current input isn't a valid number." | number digits fraction isFloat succeeded | digits := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' copyFrom: 1 to: anInteger. number := 0. succeeded := false. [digits includes: currentCharacter] whileTrue: [number := number * anInteger + (digits indexOf: currentCharacter) - 1. self step. succeeded := true]. succeeded ifFalse: [^nil]. isFloat := false. (currentCharacter == $. and: [digits includes: stream peek]) ifTrue: [self step. isFloat := true. fraction := 1 / anInteger. [digits includes: currentCharacter] whileTrue: [number := number + (((digits indexOf: currentCharacter) - 1) * fraction). fraction := fraction / anInteger. self step]]. ^isFloat ifTrue: [number asFloat] ifFalse: [number]! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanNumberWithoutExponent "Scan an IBM number with the radix -- don't scan the exponent though" | number base | base := self scanNumberOfBase: 10. (currentCharacter == $r and: [base isInteger]) ifTrue: [| position | position := stream position. self step. number := self scanNumberOfBase: base. number isNil ifTrue: ["Did not read a correct number, r must be start of a message send." stream position: position - 1. self step. number := base]] ifFalse: [number := base]. ^number! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanPatternVariable buffer nextPut: currentCharacter. self step. currentCharacter == ${ ifTrue: [self step. ^RBPatternBlockToken value: '`{' start: tokenStart]. [characterType == #alphabetic] whileFalse: [characterType == #eof ifTrue: [self scannerError: 'Meta variable expected']. buffer nextPut: currentCharacter. self step]. ^self scanIdentifierOrKeyword! ! !RBScanner methodsFor: 'private-scanning' stamp: 'bh 4/29/2000 18:01'! scanQualifier | nameStream qualifierClass | qualifierClass := Smalltalk at: #QualifiedName ifAbsent: []. qualifierClass isNil ifTrue: [^ self scannerError: 'Unknown character']. self step. "{" nameStream := WriteStream on: (String new: 10). [currentCharacter == $}] whileFalse: [nameStream nextPut: currentCharacter. self step]. self step. "}" ^ RBLiteralToken value: (qualifierClass pathString: nameStream contents) start: tokenStart stop: self previousStepPosition! ! !RBScanner methodsFor: 'private-scanning' stamp: 'ls 1/21/2000 22:38'! scanSpecialCharacter | character | currentCharacter == $: ifTrue: [self step. ^currentCharacter == $= ifTrue: [self step. RBAssignmentToken start: tokenStart] ifFalse: [RBSpecialCharacterToken value: $: start: tokenStart]]. currentCharacter = $_ ifTrue: [ self step. ^RBShortAssignmentToken start: tokenStart ]. character := currentCharacter. self step. ^RBSpecialCharacterToken value: character start: tokenStart! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanStringSymbol | literalToken | literalToken := self scanLiteralString. literalToken value: literalToken value asSymbol. ^literalToken! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! scanSymbol | lastPosition hasColon value startPosition | hasColon := false. startPosition := lastPosition := stream position. [characterType == #alphabetic] whileTrue: [self scanName. currentCharacter == $: ifTrue: [buffer nextPut: $:. hasColon := true. lastPosition := stream position. self step]]. value := buffer contents. (hasColon and: [value last ~~ $:]) ifTrue: [stream position: lastPosition. self step. value := value copyFrom: 1 to: lastPosition - startPosition + 1]. ^RBLiteralToken value: value asSymbol start: tokenStart stop: self previousStepPosition! ! !RBScanner methodsFor: 'accessing' stamp: 'bh 3/7/2000 02:17'! scanToken "fast-n-ugly. Don't write stuff like this. Has been found to cause cancer in laboratory rats. Basically a case statement. Didn't use Dictionary because lookup is pretty slow." characterType == #alphabetic ifTrue: [^self scanIdentifierOrKeyword]. (characterType == #digit or: [currentCharacter == $- and: [(self classify: stream peek) == #digit]]) ifTrue: [^self scanNumber]. characterType == #binary ifTrue: [^self scanBinary: RBBinarySelectorToken]. characterType == #special ifTrue: [^self scanSpecialCharacter]. currentCharacter == $' ifTrue: [^self scanLiteralString]. currentCharacter == $# ifTrue: [^self scanLiteral]. currentCharacter == $$ ifTrue: [^self scanLiteralCharacter]. extendedLanguage ifTrue: [currentCharacter == PatternVariableCharacter ifTrue: [^self scanPatternVariable]. currentCharacter == $} ifTrue: [^self scanSpecialCharacter]]. ^self scannerError: 'Unknown character'! ! !RBScanner methodsFor: 'error handling' stamp: ''! scannerError: aString "Evaluate the block. If it returns raise an error" self errorBlock value: aString value: self errorPosition. self error: aString! ! !RBScanner methodsFor: 'private' stamp: ''! step stream atEnd ifTrue: [characterType := #eof. ^currentCharacter := nil]. currentCharacter := stream next. characterType := self classify: currentCharacter. ^currentCharacter! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! stripComment | start stop | start := stream position. [self step == $"] whileFalse: [characterType == #eof ifTrue: [self scannerError: 'Unmatched " in comment.']]. stop := stream position. self step. comments add: (start to: stop)! ! !RBScanner methodsFor: 'private-scanning' stamp: ''! stripSeparators [[characterType == #separator] whileTrue: [self step]. currentCharacter == $"] whileTrue: [self stripComment]! ! !CompiledMethod methodsFor: '*ast' stamp: 'dvf 11/8/2003 15:01'! parseTree ^ RBParser parseMethod: self getSource asString.! ! Dictionary subclass: #RBSmallDictionary instanceVariableNames: 'values' classVariableNames: '' poolDictionaries: '' category: 'AST-ParseTree Matching'! !RBSmallDictionary commentStamp: 'md 4/1/2007 12:34' prior: 0! RBSmallDictionary is a special dictionary optimized for small collections. In addition to the normal dictionary protocol, it also supports an #empty message which "empties" the collection but may hang on to the original elements (so it could collect garbage). Without #empty we would either need to create a new dictionary or explicitly remove everything from the dictionary. Both of these take more time and #empty. Instance Variables: array array of keys (we don't use Associations for our key value pairs) tally the size of the dictionary values array of our values ! !RBSmallDictionary class methodsFor: 'instance creation' stamp: 'md 3/31/2007 11:19'! new ^self basicNew initialize: 2! ! !RBSmallDictionary class methodsFor: 'instance creation' stamp: 'md 4/3/2007 12:09'! new: aSize ^self basicNew initialize: aSize.! ! !RBSmallDictionary methodsFor: 'adding' stamp: ''! add: anAssociation self at: anAssociation key put: anAssociation value. ^anAssociation! ! !RBSmallDictionary methodsFor: 'accessing' stamp: 'md 4/13/2007 11:47'! associationAt: key ifAbsent: aBlock | index | index := self findIndexFor: key. ^index == 0 ifTrue: [aBlock value] ifFalse: [ key -> (values at: index)].! ! !RBSmallDictionary methodsFor: 'enumerating' stamp: ''! associationsDo: aBlock self keysAndValuesDo: [:key :value | aBlock value: key -> value]! ! !RBSmallDictionary methodsFor: 'accessing' stamp: ''! at: key ifAbsent: aBlock | index | index := self findIndexFor: key. ^index == 0 ifTrue: [aBlock value] ifFalse: [values at: index]! ! !RBSmallDictionary methodsFor: 'accessing' stamp: ''! at: key ifAbsentPut: aBlock | index | index := self findIndexFor: key. ^index == 0 ifTrue: [self privateAt: key put: aBlock value] ifFalse: [values at: index]! ! !RBSmallDictionary methodsFor: 'adding' stamp: ''! at: key put: value | index | index := self findIndexFor: key. ^index == 0 ifTrue: [self privateAt: key put: value] ifFalse: [values at: index put: value]! ! !RBSmallDictionary methodsFor: 'copying' stamp: 'md 3/29/2007 23:26'! copy ^self shallowCopy postCopy! ! !RBSmallDictionary methodsFor: 'enumerating' stamp: 'md 3/30/2007 16:03'! do: aBlock 1 to: tally do: [:i | aBlock value: (values at: i)]! ! !RBSmallDictionary methodsFor: 'accessing' stamp: 'md 3/30/2007 16:05'! empty tally := 0! ! !RBSmallDictionary methodsFor: 'private' stamp: 'md 3/30/2007 16:09'! findIndexFor: aKey 1 to: tally do: [:i | (array at: i) = aKey ifTrue: [^i]]. ^0! ! !RBSmallDictionary methodsFor: 'private' stamp: 'md 3/30/2007 16:04'! growKeysAndValues self growTo: tally * 2! ! !RBSmallDictionary methodsFor: 'private' stamp: 'md 3/30/2007 16:08'! growTo: aSize | newKeys newValues | newKeys := Array new: aSize. newValues := Array new: aSize. 1 to: tally do: [:i | newKeys at: i put: (array at: i). newValues at: i put: (values at: i)]. array := newKeys. values := newValues! ! !RBSmallDictionary methodsFor: 'testing' stamp: ''! includesKey: aKey ^(self findIndexFor: aKey) ~~ 0! ! !RBSmallDictionary methodsFor: 'initialize-release' stamp: 'md 4/3/2007 12:10'! initialize: size array := Array new: size. values := Array new: size. tally := 0! ! !RBSmallDictionary methodsFor: 'enumerating' stamp: 'md 3/30/2007 16:09'! keysAndValuesDo: aBlock 1 to: tally do: [:i | aBlock value: (array at: i) value: (values at: i)]! ! !RBSmallDictionary methodsFor: 'enumerating' stamp: 'md 3/30/2007 16:08'! keysDo: aBlock 1 to: tally do: [:i | aBlock value: (array at: i)]! ! !RBSmallDictionary methodsFor: 'adding' stamp: 'md 4/13/2007 11:49'! noCheckAdd: anObject ^self add: anObject! ! !RBSmallDictionary methodsFor: 'copying' stamp: 'md 3/30/2007 16:09'! postCopy array := array copy. values := values copy! ! !RBSmallDictionary methodsFor: 'private' stamp: 'md 3/30/2007 16:08'! privateAt: key put: value tally == array size ifTrue: [self growKeysAndValues]. tally := tally + 1. array at: tally put: key. ^values at: tally put: value! ! !RBSmallDictionary methodsFor: 'private' stamp: 'md 4/13/2007 16:45'! rehash "do nothing for now"! ! !RBSmallDictionary methodsFor: 'removing' stamp: 'md 3/29/2007 23:24'! remove:anAssociation self removeKey: anAssociation key.! ! !RBSmallDictionary methodsFor: 'removing' stamp: ''! remove: oldObject ifAbsent: anExceptionBlock self removeKey: oldObject key ifAbsent: anExceptionBlock. ^oldObject! ! !RBSmallDictionary methodsFor: 'removing' stamp: 'md 3/30/2007 16:09'! removeKey: key ifAbsent: aBlock | index value | index := self findIndexFor: key. index == 0 ifTrue: [^aBlock value]. value := values at: index. index to: tally - 1 do: [:i | array at: i put: (array at: i + 1). values at: i put: (values at: i + 1)]. array at: tally put: nil. values at: tally put: nil. tally := tally - 1. ^value! ! !RBSmallDictionary methodsFor: 'accessing' stamp: 'md 3/30/2007 16:04'! size ^tally! ! RBSmallDictionary subclass: #RBSmallIdentityDictionary instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'AST-ParseTree Matching'! !RBSmallIdentityDictionary methodsFor: 'private' stamp: 'md 4/2/2007 08:21'! findIndexFor: aKey 1 to: tally do: [:i | (array at: i) == aKey ifTrue: [^i]]. ^0! ! !RBSmallIdentityDictionary methodsFor: 'accessing' stamp: 'md 4/2/2007 08:27'! keys "Answer a Set containing the receiver's keys." | aSet | aSet := IdentitySet new: self size. self keysDo: [:key | aSet add: key]. ^ aSet! ! !Trait methodsFor: '*ast' stamp: 'md 4/6/2007 14:20'! isVariable "hack for Lint" ^false! ! !Trait methodsFor: '*ast' stamp: 'md 4/6/2007 14:20'! superclass "hack for Lint" ^nil! ! !Trait methodsFor: '*ast' stamp: 'md 4/6/2007 14:20'! withAllSubclasses "hack for Lint" ^Array with: self! ! RBProgramNode initialize! RBScanner initialize!