From ad17da6fc6ea7c75286cb3bcc75b1a17d787a0cc Mon Sep 17 00:00:00 2001 From: CyrilFerlicot Date: Tue, 17 Sep 2024 14:00:17 +0200 Subject: [PATCH 1/2] Rename AST tokens to start with AST --- .../ASTCommentNodeTest.class.st | 2 +- ...Test.class.st => ASTEOFTokenTest.class.st} | 14 ++--- ...n.class.st => ASTAssignmentToken.class.st} | 10 ++-- ...ass.st => ASTBinarySelectorToken.class.st} | 8 +-- src/AST-Core/ASTCommentNode.class.st | 2 +- ...oken.class.st => ASTCommentToken.class.st} | 16 ++--- ...EOFToken.class.st => ASTEOFToken.class.st} | 12 ++-- ...rToken.class.st => ASTErrorToken.class.st} | 16 ++--- ...n.class.st => ASTIdentifierToken.class.st} | 10 ++-- ...oken.class.st => ASTKeywordToken.class.st} | 10 ++-- ...class.st => ASTLiteralArrayToken.class.st} | 8 +-- ...oken.class.st => ASTLiteralToken.class.st} | 26 ++++---- ...lass.st => ASTNumberLiteralToken.class.st} | 8 +-- ...class.st => ASTPatternBlockToken.class.st} | 6 +- ...s.st => ASTSpecialCharacterToken.class.st} | 10 ++-- .../{RBToken.class.st => ASTToken.class.st} | 60 +++++++++---------- ...eToken.class.st => ASTValueToken.class.st} | 22 +++---- src/AST-Core/RBParser.class.st | 10 ++-- src/AST-Core/RBPatternParser.class.st | 2 +- src/AST-Core/RBPatternScanner.class.st | 2 +- src/AST-Core/RBScanner.class.st | 32 +++++----- .../BaselineOfBasicTools.class.st | 15 +++++ 22 files changed, 158 insertions(+), 143 deletions(-) rename src/AST-Core-Tests/{RBEOFTokenTest.class.st => ASTEOFTokenTest.class.st} (67%) rename src/AST-Core/{RBAssignmentToken.class.st => ASTAssignmentToken.class.st} (64%) rename src/AST-Core/{RBBinarySelectorToken.class.st => ASTBinarySelectorToken.class.st} (63%) rename src/AST-Core/{RBCommentToken.class.st => ASTCommentToken.class.st} (64%) rename src/AST-Core/{RBEOFToken.class.st => ASTEOFToken.class.st} (62%) rename src/AST-Core/{RBErrorToken.class.st => ASTErrorToken.class.st} (62%) rename src/AST-Core/{RBIdentifierToken.class.st => ASTIdentifierToken.class.st} (71%) rename src/AST-Core/{RBKeywordToken.class.st => ASTKeywordToken.class.st} (66%) rename src/AST-Core/{RBLiteralArrayToken.class.st => ASTLiteralArrayToken.class.st} (62%) rename src/AST-Core/{RBLiteralToken.class.st => ASTLiteralToken.class.st} (73%) rename src/AST-Core/{RBNumberLiteralToken.class.st => ASTNumberLiteralToken.class.st} (75%) rename src/AST-Core/{RBPatternBlockToken.class.st => ASTPatternBlockToken.class.st} (66%) rename src/AST-Core/{RBSpecialCharacterToken.class.st => ASTSpecialCharacterToken.class.st} (59%) rename src/AST-Core/{RBToken.class.st => ASTToken.class.st} (69%) rename src/AST-Core/{RBValueToken.class.st => ASTValueToken.class.st} (69%) diff --git a/src/AST-Core-Tests/ASTCommentNodeTest.class.st b/src/AST-Core-Tests/ASTCommentNodeTest.class.st index 395606cd8f5..ee950e9e2c0 100644 --- a/src/AST-Core-Tests/ASTCommentNodeTest.class.st +++ b/src/AST-Core-Tests/ASTCommentNodeTest.class.st @@ -18,7 +18,7 @@ ASTCommentNodeTest >> testFoo [ { #category : 'tests' } ASTCommentNodeTest >> testIntersectsInterval [ | node | - node:= ASTCommentNode with: (RBCommentToken value: 'Some sample text' start: 5 stop: 21). + node:= ASTCommentNode with: (ASTCommentToken value: 'Some sample text' start: 5 stop: 21). self assert: (node intersectsInterval: (4 to: 6)) description: 'either side of interval'; diff --git a/src/AST-Core-Tests/RBEOFTokenTest.class.st b/src/AST-Core-Tests/ASTEOFTokenTest.class.st similarity index 67% rename from src/AST-Core-Tests/RBEOFTokenTest.class.st rename to src/AST-Core-Tests/ASTEOFTokenTest.class.st index 9ab19256fde..77e57df449f 100644 --- a/src/AST-Core-Tests/RBEOFTokenTest.class.st +++ b/src/AST-Core-Tests/ASTEOFTokenTest.class.st @@ -1,5 +1,5 @@ Class { - #name : 'RBEOFTokenTest', + #name : 'ASTEOFTokenTest', #superclass : 'TestCase', #instVars : [ 'token' @@ -10,31 +10,31 @@ Class { } { #category : 'running' } -RBEOFTokenTest >> setUp [ +ASTEOFTokenTest >> setUp [ super setUp. - token := RBEOFToken start: (1 to: 10) + token := ASTEOFToken start: (1 to: 10) ] { #category : 'tests' } -RBEOFTokenTest >> testLength [ +ASTEOFTokenTest >> testLength [ self assert: token length equals: 0 ] { #category : 'tests' } -RBEOFTokenTest >> testSource [ +ASTEOFTokenTest >> testSource [ self assert: token source equals: String empty ] { #category : 'tests' } -RBEOFTokenTest >> testValue [ +ASTEOFTokenTest >> testValue [ self assert: token value equals: String empty ] { #category : 'tests' } -RBEOFTokenTest >> testisEOF [ +ASTEOFTokenTest >> testisEOF [ self assert: token isEOF ] diff --git a/src/AST-Core/RBAssignmentToken.class.st b/src/AST-Core/ASTAssignmentToken.class.st similarity index 64% rename from src/AST-Core/RBAssignmentToken.class.st rename to src/AST-Core/ASTAssignmentToken.class.st index fb4538ee446..377e1f2b3d1 100644 --- a/src/AST-Core/RBAssignmentToken.class.st +++ b/src/AST-Core/ASTAssignmentToken.class.st @@ -3,25 +3,25 @@ RBAssignmentToken is the first-class representation of the assignment token ':=' " Class { - #name : 'RBAssignmentToken', - #superclass : 'RBToken', + #name : 'ASTAssignmentToken', + #superclass : 'ASTToken', #category : 'AST-Core-Tokens', #package : 'AST-Core', #tag : 'Tokens' } { #category : 'testing' } -RBAssignmentToken >> isAssignment [ +ASTAssignmentToken >> isAssignment [ ^true ] { #category : 'accessing' } -RBAssignmentToken >> length [ +ASTAssignmentToken >> length [ ^ 2 ] { #category : 'evaluating' } -RBAssignmentToken >> value [ +ASTAssignmentToken >> value [ ^':=' ] diff --git a/src/AST-Core/RBBinarySelectorToken.class.st b/src/AST-Core/ASTBinarySelectorToken.class.st similarity index 63% rename from src/AST-Core/RBBinarySelectorToken.class.st rename to src/AST-Core/ASTBinarySelectorToken.class.st index 2ac5d0c78ce..acbae78285d 100644 --- a/src/AST-Core/RBBinarySelectorToken.class.st +++ b/src/AST-Core/ASTBinarySelectorToken.class.st @@ -3,19 +3,19 @@ RBBinarySelectorToken is the first-class representation of a binary selector (e. " Class { - #name : 'RBBinarySelectorToken', - #superclass : 'RBValueToken', + #name : 'ASTBinarySelectorToken', + #superclass : 'ASTValueToken', #category : 'AST-Core-Tokens', #package : 'AST-Core', #tag : 'Tokens' } { #category : 'testing' } -RBBinarySelectorToken >> isBinary [ +ASTBinarySelectorToken >> isBinary [ ^true ] { #category : 'testing' } -RBBinarySelectorToken >> isBinary: aString [ +ASTBinarySelectorToken >> isBinary: aString [ ^ value = aString ] diff --git a/src/AST-Core/ASTCommentNode.class.st b/src/AST-Core/ASTCommentNode.class.st index 80e37a28270..0f4032e0014 100644 --- a/src/AST-Core/ASTCommentNode.class.st +++ b/src/AST-Core/ASTCommentNode.class.st @@ -54,7 +54,7 @@ ASTCommentNode class >> with: aCommentToken [ { #category : 'instance creation' } ASTCommentNode class >> with: aString at: startPosition [ - ^ self with: (RBCommentToken + ^ self with: (ASTCommentToken value: aString start: startPosition stop: startPosition + aString size - 1) diff --git a/src/AST-Core/RBCommentToken.class.st b/src/AST-Core/ASTCommentToken.class.st similarity index 64% rename from src/AST-Core/RBCommentToken.class.st rename to src/AST-Core/ASTCommentToken.class.st index 023d632eb98..d94d4ac7c58 100644 --- a/src/AST-Core/RBCommentToken.class.st +++ b/src/AST-Core/ASTCommentToken.class.st @@ -2,8 +2,8 @@ First class representation of a scanned comment " Class { - #name : 'RBCommentToken', - #superclass : 'RBValueToken', + #name : 'ASTCommentToken', + #superclass : 'ASTValueToken', #instVars : [ 'stopPosition' ], @@ -13,35 +13,35 @@ Class { } { #category : 'instance creation' } -RBCommentToken class >> value: aString start: aStartPosition stop: aStopPosition [ +ASTCommentToken class >> value: aString start: aStartPosition stop: aStopPosition [ ^self new value: aString; start: aStartPosition; stop: aStopPosition ] { #category : 'accessing' } -RBCommentToken >> first [ +ASTCommentToken >> first [ ^ self start ] { #category : 'testing' } -RBCommentToken >> isComment [ +ASTCommentToken >> isComment [ ^true ] { #category : 'accessing' } -RBCommentToken >> last [ +ASTCommentToken >> last [ ^ self stop ] { #category : 'accessing' } -RBCommentToken >> stop [ +ASTCommentToken >> stop [ ^ stopPosition ] { #category : 'accessing' } -RBCommentToken >> stop: aPosition [ +ASTCommentToken >> stop: aPosition [ stopPosition := aPosition ] diff --git a/src/AST-Core/RBEOFToken.class.st b/src/AST-Core/ASTEOFToken.class.st similarity index 62% rename from src/AST-Core/RBEOFToken.class.st rename to src/AST-Core/ASTEOFToken.class.st index a153c034c8b..7183284f15c 100644 --- a/src/AST-Core/RBEOFToken.class.st +++ b/src/AST-Core/ASTEOFToken.class.st @@ -1,28 +1,28 @@ Class { - #name : 'RBEOFToken', - #superclass : 'RBToken', + #name : 'ASTEOFToken', + #superclass : 'ASTToken', #category : 'AST-Core-Tokens', #package : 'AST-Core', #tag : 'Tokens' } { #category : 'testing' } -RBEOFToken >> isEOF [ +ASTEOFToken >> isEOF [ ^true ] { #category : 'accessing' } -RBEOFToken >> length [ +ASTEOFToken >> length [ ^ 0 ] { #category : 'accessing' } -RBEOFToken >> source [ +ASTEOFToken >> source [ ^ self value ] { #category : 'accessing' } -RBEOFToken >> value [ +ASTEOFToken >> value [ ^ '' ] diff --git a/src/AST-Core/RBErrorToken.class.st b/src/AST-Core/ASTErrorToken.class.st similarity index 62% rename from src/AST-Core/RBErrorToken.class.st rename to src/AST-Core/ASTErrorToken.class.st index 9e919ad2815..ed349c2c0d8 100644 --- a/src/AST-Core/RBErrorToken.class.st +++ b/src/AST-Core/ASTErrorToken.class.st @@ -3,8 +3,8 @@ I'm a scanned error. I can have multiple causes. " Class { - #name : 'RBErrorToken', - #superclass : 'RBValueToken', + #name : 'ASTErrorToken', + #superclass : 'ASTValueToken', #instVars : [ 'cause', 'location' @@ -15,7 +15,7 @@ Class { } { #category : 'instance creation' } -RBErrorToken class >> value: value start: tokenStart cause: errorCause location: thePosition [ +ASTErrorToken class >> value: value start: tokenStart cause: errorCause location: thePosition [ ^ self new value: value start: tokenStart @@ -25,27 +25,27 @@ RBErrorToken class >> value: value start: tokenStart cause: errorCause location: ] { #category : 'accessing' } -RBErrorToken >> cause [ +ASTErrorToken >> cause [ ^ cause ] { #category : 'testing' } -RBErrorToken >> isError [ +ASTErrorToken >> isError [ ^true ] { #category : 'accessing' } -RBErrorToken >> location [ +ASTErrorToken >> location [ ^ location ] { #category : 'accessing' } -RBErrorToken >> location: anInteger [ +ASTErrorToken >> location: anInteger [ location := anInteger ] { #category : 'accessing' } -RBErrorToken >> value: theValue start: tokenStart cause: errorCause location: errorPosition [ +ASTErrorToken >> value: theValue start: tokenStart cause: errorCause location: errorPosition [ self value: theValue start: tokenStart. location := errorPosition. cause := errorCause diff --git a/src/AST-Core/RBIdentifierToken.class.st b/src/AST-Core/ASTIdentifierToken.class.st similarity index 71% rename from src/AST-Core/RBIdentifierToken.class.st rename to src/AST-Core/ASTIdentifierToken.class.st index 6c8e908527e..de174c2bf2c 100644 --- a/src/AST-Core/RBIdentifierToken.class.st +++ b/src/AST-Core/ASTIdentifierToken.class.st @@ -3,25 +3,25 @@ RBIdentifierToken is the first-class representation of an identifier token (e.g. " Class { - #name : 'RBIdentifierToken', - #superclass : 'RBValueToken', + #name : 'ASTIdentifierToken', + #superclass : 'ASTValueToken', #category : 'AST-Core-Tokens', #package : 'AST-Core', #tag : 'Tokens' } { #category : 'testing' } -RBIdentifierToken >> isIdentifier [ +ASTIdentifierToken >> isIdentifier [ ^true ] { #category : 'testing' } -RBIdentifierToken >> isKeywordPattern [ +ASTIdentifierToken >> isKeywordPattern [ ^ self isPatternVariable and: [ value second = RBScanner keywordPatternCharacter and: [ value third ~= RBScanner cascadePatternCharacter ] ] ] { #category : 'testing' } -RBIdentifierToken >> isPatternVariable [ +ASTIdentifierToken >> isPatternVariable [ ^value first = RBScanner patternVariableCharacter ] diff --git a/src/AST-Core/RBKeywordToken.class.st b/src/AST-Core/ASTKeywordToken.class.st similarity index 66% rename from src/AST-Core/RBKeywordToken.class.st rename to src/AST-Core/ASTKeywordToken.class.st index e166f8da4eb..0bd4a1793dc 100644 --- a/src/AST-Core/RBKeywordToken.class.st +++ b/src/AST-Core/ASTKeywordToken.class.st @@ -2,24 +2,24 @@ RBKeywordToken is the first-class representation of a keyword token (e.g. add:) " Class { - #name : 'RBKeywordToken', - #superclass : 'RBValueToken', + #name : 'ASTKeywordToken', + #superclass : 'ASTValueToken', #category : 'AST-Core-Tokens', #package : 'AST-Core', #tag : 'Tokens' } { #category : 'testing' } -RBKeywordToken >> isKeyword [ +ASTKeywordToken >> isKeyword [ ^true ] { #category : 'testing' } -RBKeywordToken >> isPatternVariable [ +ASTKeywordToken >> isPatternVariable [ ^value first = RBScanner patternVariableCharacter ] { #category : 'testing' } -RBKeywordToken >> isPrimitiveKeyword [ +ASTKeywordToken >> isPrimitiveKeyword [ ^ self value = #primitive: ] diff --git a/src/AST-Core/RBLiteralArrayToken.class.st b/src/AST-Core/ASTLiteralArrayToken.class.st similarity index 62% rename from src/AST-Core/RBLiteralArrayToken.class.st rename to src/AST-Core/ASTLiteralArrayToken.class.st index 0fc4cefa4c3..bea3644144b 100644 --- a/src/AST-Core/RBLiteralArrayToken.class.st +++ b/src/AST-Core/ASTLiteralArrayToken.class.st @@ -3,19 +3,19 @@ I am the start of a literal array, normal literal arrays `#()` or byte arrays `# " Class { - #name : 'RBLiteralArrayToken', - #superclass : 'RBValueToken', + #name : 'ASTLiteralArrayToken', + #superclass : 'ASTValueToken', #category : 'AST-Core-Tokens', #package : 'AST-Core', #tag : 'Tokens' } { #category : 'testing' } -RBLiteralArrayToken >> isForByteArray [ +ASTLiteralArrayToken >> isForByteArray [ ^value last = $[ ] { #category : 'testing' } -RBLiteralArrayToken >> isLiteralArrayToken [ +ASTLiteralArrayToken >> isLiteralArrayToken [ ^true ] diff --git a/src/AST-Core/RBLiteralToken.class.st b/src/AST-Core/ASTLiteralToken.class.st similarity index 73% rename from src/AST-Core/RBLiteralToken.class.st rename to src/AST-Core/ASTLiteralToken.class.st index b242dd5602e..ebd508a48ff 100644 --- a/src/AST-Core/RBLiteralToken.class.st +++ b/src/AST-Core/ASTLiteralToken.class.st @@ -7,8 +7,8 @@ Instance Variables: " Class { - #name : 'RBLiteralToken', - #superclass : 'RBValueToken', + #name : 'ASTLiteralToken', + #superclass : 'ASTValueToken', #instVars : [ 'stopPosition', 'source' @@ -19,7 +19,7 @@ Class { } { #category : 'instance creation' } -RBLiteralToken class >> value: anObject [ +ASTLiteralToken class >> value: anObject [ | literal | literal := anObject class == Array ifTrue: [anObject collect: [:each | self value: each]] @@ -31,12 +31,12 @@ RBLiteralToken class >> value: anObject [ ] { #category : 'instance creation' } -RBLiteralToken class >> value: aString start: anInteger stop: stopInteger [ +ASTLiteralToken class >> value: aString start: anInteger stop: stopInteger [ ^ self value: aString start: anInteger stop: stopInteger source: nil ] { #category : 'instance creation' } -RBLiteralToken class >> value: aString start: anInteger stop: stopInteger source: sourceText [ +ASTLiteralToken class >> value: aString start: anInteger stop: stopInteger source: sourceText [ ^(self new) value: aString start: anInteger @@ -46,37 +46,37 @@ RBLiteralToken class >> value: aString start: anInteger stop: stopInteger source ] { #category : 'testing' } -RBLiteralToken >> isLiteralToken [ +ASTLiteralToken >> isLiteralToken [ ^true ] { #category : 'private' } -RBLiteralToken >> length [ +ASTLiteralToken >> length [ ^stopPosition - self start + 1 ] { #category : 'accessing' } -RBLiteralToken >> realValue [ +ASTLiteralToken >> realValue [ ^value ] { #category : 'accessing' } -RBLiteralToken >> source [ +ASTLiteralToken >> source [ ^source ] { #category : 'initialization' } -RBLiteralToken >> source: aString [ +ASTLiteralToken >> source: aString [ source := aString ] { #category : 'accessing' } -RBLiteralToken >> stop: anObject [ +ASTLiteralToken >> stop: anObject [ stopPosition := anObject ] { #category : 'storing' } -RBLiteralToken >> storeOn: aStream [ +ASTLiteralToken >> storeOn: aStream [ value isSymbol ifTrue: [aStream nextPut: $#. @@ -94,7 +94,7 @@ RBLiteralToken >> storeOn: aStream [ ] { #category : 'initialization' } -RBLiteralToken >> value: aString start: anInteger stop: stopInteger [ +ASTLiteralToken >> value: aString start: anInteger stop: stopInteger [ value := aString. sourcePointer := anInteger. stopPosition := stopInteger diff --git a/src/AST-Core/RBNumberLiteralToken.class.st b/src/AST-Core/ASTNumberLiteralToken.class.st similarity index 75% rename from src/AST-Core/RBNumberLiteralToken.class.st rename to src/AST-Core/ASTNumberLiteralToken.class.st index c513258d5c1..c52fcaf5a87 100644 --- a/src/AST-Core/RBNumberLiteralToken.class.st +++ b/src/AST-Core/ASTNumberLiteralToken.class.st @@ -6,19 +6,19 @@ the scanner produces the tokens 'a' and '-1'. This will be converted to the toke 'a', the binary selector token '-' and the number literal token '1'. " Class { - #name : 'RBNumberLiteralToken', - #superclass : 'RBLiteralToken', + #name : 'ASTNumberLiteralToken', + #superclass : 'ASTLiteralToken', #category : 'AST-Core-Tokens', #package : 'AST-Core', #tag : 'Tokens' } { #category : 'testing' } -RBNumberLiteralToken >> isNumberLiteralToken [ +ASTNumberLiteralToken >> isNumberLiteralToken [ ^true ] { #category : 'storing' } -RBNumberLiteralToken >> storeOn: aStream [ +ASTNumberLiteralToken >> storeOn: aStream [ aStream nextPutAll: source ] diff --git a/src/AST-Core/RBPatternBlockToken.class.st b/src/AST-Core/ASTPatternBlockToken.class.st similarity index 66% rename from src/AST-Core/RBPatternBlockToken.class.st rename to src/AST-Core/ASTPatternBlockToken.class.st index 9befe88a138..a3ecfba4a63 100644 --- a/src/AST-Core/RBPatternBlockToken.class.st +++ b/src/AST-Core/ASTPatternBlockToken.class.st @@ -4,14 +4,14 @@ RBPatternBlockToken is the first-class representation of the pattern block token " Class { - #name : 'RBPatternBlockToken', - #superclass : 'RBValueToken', + #name : 'ASTPatternBlockToken', + #superclass : 'ASTValueToken', #category : 'AST-Core-Tokens', #package : 'AST-Core', #tag : 'Tokens' } { #category : 'testing' } -RBPatternBlockToken >> isPatternBlock [ +ASTPatternBlockToken >> isPatternBlock [ ^true ] diff --git a/src/AST-Core/RBSpecialCharacterToken.class.st b/src/AST-Core/ASTSpecialCharacterToken.class.st similarity index 59% rename from src/AST-Core/RBSpecialCharacterToken.class.st rename to src/AST-Core/ASTSpecialCharacterToken.class.st index 1da0934ee01..04a53f261b7 100644 --- a/src/AST-Core/RBSpecialCharacterToken.class.st +++ b/src/AST-Core/ASTSpecialCharacterToken.class.st @@ -4,24 +4,24 @@ RBSpecialCharacterToken is the first-class representation of special characters. " Class { - #name : 'RBSpecialCharacterToken', - #superclass : 'RBValueToken', + #name : 'ASTSpecialCharacterToken', + #superclass : 'ASTValueToken', #category : 'AST-Core-Tokens', #package : 'AST-Core', #tag : 'Tokens' } { #category : 'testing' } -RBSpecialCharacterToken >> isSpecial [ +ASTSpecialCharacterToken >> isSpecial [ ^true ] { #category : 'testing' } -RBSpecialCharacterToken >> isSpecial: aValue [ +ASTSpecialCharacterToken >> isSpecial: aValue [ ^self value = aValue ] { #category : 'private' } -RBSpecialCharacterToken >> length [ +ASTSpecialCharacterToken >> length [ ^1 ] diff --git a/src/AST-Core/RBToken.class.st b/src/AST-Core/ASTToken.class.st similarity index 69% rename from src/AST-Core/RBToken.class.st rename to src/AST-Core/ASTToken.class.st index a9372bac571..dfb33db190e 100644 --- a/src/AST-Core/RBToken.class.st +++ b/src/AST-Core/ASTToken.class.st @@ -10,7 +10,7 @@ Instance Variables: " Class { - #name : 'RBToken', + #name : 'ASTToken', #superclass : 'Object', #instVars : [ 'sourcePointer', @@ -22,147 +22,147 @@ Class { } { #category : 'testing' } -RBToken class >> isAbstract [ +ASTToken class >> isAbstract [ - ^ self == RBToken + ^ self == ASTToken ] { #category : 'instance creation' } -RBToken class >> start: anInterval [ +ASTToken class >> start: anInterval [ ^self new start: anInterval ] { #category : 'accessing' } -RBToken >> comments [ +ASTToken >> comments [ ^comments ] { #category : 'accessing' } -RBToken >> comments: anObject [ +ASTToken >> comments: anObject [ comments := anObject ] { #category : 'testing' } -RBToken >> isAssignment [ +ASTToken >> isAssignment [ ^false ] { #category : 'testing' } -RBToken >> isBinary [ +ASTToken >> isBinary [ ^false ] { #category : 'testing' } -RBToken >> isBinary: aString [ +ASTToken >> isBinary: aString [ ^false ] { #category : 'testing' } -RBToken >> isComment [ +ASTToken >> isComment [ ^false ] { #category : 'testing' } -RBToken >> isEOF [ +ASTToken >> isEOF [ ^false ] { #category : 'testing' } -RBToken >> isError [ +ASTToken >> isError [ ^false ] { #category : 'testing' } -RBToken >> isIdentifier [ +ASTToken >> isIdentifier [ ^false ] { #category : 'testing' } -RBToken >> isKeyword [ +ASTToken >> isKeyword [ ^false ] { #category : 'testing' } -RBToken >> isKeywordPattern [ +ASTToken >> isKeywordPattern [ ^ false ] { #category : 'testing' } -RBToken >> isLiteralArrayToken [ +ASTToken >> isLiteralArrayToken [ ^false ] { #category : 'testing' } -RBToken >> isLiteralToken [ +ASTToken >> isLiteralToken [ ^false ] { #category : 'testing' } -RBToken >> isNumberLiteralToken [ +ASTToken >> isNumberLiteralToken [ ^false ] { #category : 'testing' } -RBToken >> isPatternBlock [ +ASTToken >> isPatternBlock [ ^false ] { #category : 'testing' } -RBToken >> isPatternVariable [ +ASTToken >> isPatternVariable [ ^false ] { #category : 'testing' } -RBToken >> isPrimitiveKeyword [ +ASTToken >> isPrimitiveKeyword [ ^ false ] { #category : 'testing' } -RBToken >> isSpecial [ +ASTToken >> isSpecial [ ^false ] { #category : 'testing' } -RBToken >> isSpecial: aValue [ +ASTToken >> isSpecial: aValue [ ^false ] { #category : 'testing' } -RBToken >> isTouching: other [ +ASTToken >> isTouching: other [ "is self just before other token (without space or comments)" ^ self stop + 1 = other start ] { #category : 'accessing' } -RBToken >> length [ +ASTToken >> length [ ^self subclassResponsibility ] { #category : 'printing' } -RBToken >> printOn: aStream [ +ASTToken >> printOn: aStream [ aStream nextPut: $ ; nextPutAll: self class name ] { #category : 'accessing' } -RBToken >> removePositions [ +ASTToken >> removePositions [ sourcePointer := nil ] { #category : 'accessing' } -RBToken >> start [ +ASTToken >> start [ ^ sourcePointer ifNil: [ 0 ] ] { #category : 'initialization' } -RBToken >> start: anInteger [ +ASTToken >> start: anInteger [ sourcePointer := anInteger ] { #category : 'accessing' } -RBToken >> stop [ +ASTToken >> stop [ ^ sourcePointer ifNil: [ -1 ] ifNotNil: [ self start + self length - 1 ] diff --git a/src/AST-Core/RBValueToken.class.st b/src/AST-Core/ASTValueToken.class.st similarity index 69% rename from src/AST-Core/RBValueToken.class.st rename to src/AST-Core/ASTValueToken.class.st index 429d377acdc..5320d723c8f 100644 --- a/src/AST-Core/RBValueToken.class.st +++ b/src/AST-Core/ASTValueToken.class.st @@ -7,8 +7,8 @@ Instance Variables: " Class { - #name : 'RBValueToken', - #superclass : 'RBToken', + #name : 'ASTValueToken', + #superclass : 'ASTToken', #instVars : [ 'value' ], @@ -18,23 +18,23 @@ Class { } { #category : 'testing' } -RBValueToken class >> isAbstract [ +ASTValueToken class >> isAbstract [ - ^ self == RBValueToken + ^ self == ASTValueToken ] { #category : 'instance creation' } -RBValueToken class >> value: aString start: anInteger [ +ASTValueToken class >> value: aString start: anInteger [ ^self new value: aString start: anInteger ] { #category : 'private' } -RBValueToken >> length [ +ASTValueToken >> length [ ^value size ] { #category : 'printing' } -RBValueToken >> printOn: aStream [ +ASTValueToken >> printOn: aStream [ super printOn: aStream. aStream nextPut: $(. value printOn: aStream. @@ -42,22 +42,22 @@ RBValueToken >> printOn: aStream [ ] { #category : 'accessing' } -RBValueToken >> source [ +ASTValueToken >> source [ ^ self value ] { #category : 'accessing' } -RBValueToken >> value [ +ASTValueToken >> value [ ^value ] { #category : 'accessing' } -RBValueToken >> value: anObject [ +ASTValueToken >> value: anObject [ value := anObject ] { #category : 'initialization' } -RBValueToken >> value: aString start: anInteger [ +ASTValueToken >> value: aString start: anInteger [ value := aString. sourcePointer := anInteger ] diff --git a/src/AST-Core/RBParser.class.st b/src/AST-Core/RBParser.class.st index 7132f5044ce..6798bce6e23 100644 --- a/src/AST-Core/RBParser.class.st +++ b/src/AST-Core/RBParser.class.st @@ -1206,11 +1206,11 @@ RBParser >> parseVariableNode [ RBParser >> patchLiteralMessage [ currentToken value == true - ifTrue: [ ^ currentToken := RBIdentifierToken value: 'true' start: currentToken start ]. + ifTrue: [ ^ currentToken := ASTIdentifierToken value: 'true' start: currentToken start ]. currentToken value == false - ifTrue: [ ^ currentToken := RBIdentifierToken value: 'false' start: currentToken start ]. + ifTrue: [ ^ currentToken := ASTIdentifierToken value: 'false' start: currentToken start ]. currentToken value - ifNil: [ ^ currentToken := RBIdentifierToken value: 'nil' start: currentToken start ] + ifNil: [ ^ currentToken := ASTIdentifierToken value: 'nil' start: currentToken start ] ] { #category : 'private' } @@ -1227,9 +1227,9 @@ RBParser >> patchNegativeLiteral [ and: [(source at: (currentToken start min: source size)) = $-]]) ifFalse: [^self]]. nextToken := currentToken. - currentToken := RBBinarySelectorToken value: #- start: nextToken start. + currentToken := ASTBinarySelectorToken value: #- start: nextToken start. nextToken value: nextToken value negated. - (nextToken isKindOf: RBNumberLiteralToken) + (nextToken isKindOf: ASTNumberLiteralToken) ifTrue: [nextToken source: (nextToken source allButFirst)]. nextToken start: nextToken start + 1 diff --git a/src/AST-Core/RBPatternParser.class.st b/src/AST-Core/RBPatternParser.class.st index e52feea8256..202a9ddab46 100644 --- a/src/AST-Core/RBPatternParser.class.st +++ b/src/AST-Core/RBPatternParser.class.st @@ -90,7 +90,7 @@ RBPatternParser >> parsePrimitiveLiteral [ ifTrue: [self step. ^node]. - currentToken := RBLiteralToken + currentToken := ASTLiteralToken value: currentToken value asSymbol start: currentToken start stop: currentToken stop]. diff --git a/src/AST-Core/RBPatternScanner.class.st b/src/AST-Core/RBPatternScanner.class.st index 803435579c8..a3199458987 100644 --- a/src/AST-Core/RBPatternScanner.class.st +++ b/src/AST-Core/RBPatternScanner.class.st @@ -17,7 +17,7 @@ RBPatternScanner >> scanPatternVariable [ currentCharacter = ${ ifTrue: [self step. - ^RBPatternBlockToken value: '`{' start: tokenStart]. + ^ASTPatternBlockToken value: '`{' start: tokenStart]. [characterType = #alphabetic] whileFalse: [characterType = #eof ifTrue: [ ^ self scanError: 'Meta variable expected']. diff --git a/src/AST-Core/RBScanner.class.st b/src/AST-Core/RBScanner.class.st index f15af81e97b..5c15ad88ed3 100644 --- a/src/AST-Core/RBScanner.class.st +++ b/src/AST-Core/RBScanner.class.st @@ -345,7 +345,7 @@ RBScanner >> scanBinary: aClass [ { #category : 'private - scanning' } RBScanner >> scanBinarySelector [ "Used when binary characters are encountered and not beginning with #" - ^self scanBinary: RBBinarySelectorToken + ^self scanBinary: ASTBinarySelectorToken ] { #category : 'private - scanning' } @@ -364,7 +364,7 @@ RBScanner >> scanComment [ stop := self atEnd ifTrue: [ stream position ] ifFalse: [ stream position - 1 ]. - ^ RBCommentToken value: buffer contents start: start stop: stop + ^ ASTCommentToken value: buffer contents start: start stop: stop ] { #category : 'private - scanning' } @@ -378,7 +378,7 @@ RBScanner >> scanError: theCause from: aPosition [ "The value of the error token is the verbatim text from aPosition (included) to the current position (not included). The error location is index of the current (problematic) character. Or index of the last character + 1 if eof." - ^ RBErrorToken + ^ ASTErrorToken value: (self scanBackFrom: aPosition) start: aPosition cause: theCause @@ -399,10 +399,10 @@ RBScanner >> scanIdentifierOrKeyword [ buffer nextPut: currentCharacter. self step. name := buffer contents. - ^RBKeywordToken value: name start: tokenStart ]. + ^ASTKeywordToken value: name start: tokenStart ]. name := buffer contents. (self scanNamedLiteral: name) ifNotNil: [ :token | ^ token ]. - ^RBIdentifierToken value: name start: tokenStart + ^ASTIdentifierToken value: name start: tokenStart ] { #category : 'private - scanning' } @@ -432,7 +432,7 @@ RBScanner >> scanLiteralArrayToken [ "This scan accepts any character but is only meant to be used when a # is followed by ( or [ ." | token | self step. - token := RBLiteralArrayToken + token := ASTLiteralArrayToken value: (self scanBackFrom: tokenStart) start: tokenStart. ^token @@ -441,7 +441,7 @@ RBScanner >> scanLiteralArrayToken [ { #category : 'private - scanning' } RBScanner >> scanLiteralBinary [ "Used when binary characters are encountered and beginning with #" - ^ (self scanBinary: RBLiteralToken) stop: self previousStepPosition + ^ (self scanBinary: ASTLiteralToken) stop: self previousStepPosition ] { #category : 'private - scanning' } @@ -460,7 +460,7 @@ RBScanner >> scanLiteralCharacter [ { #category : 'private - scanning' } RBScanner >> scanLiteralForValue: aValue [ - ^ RBLiteralToken + ^ ASTLiteralToken value: aValue start: tokenStart stop: self previousStepPosition @@ -478,7 +478,7 @@ RBScanner >> scanLiteralString [ So if the stream did not move of if the last char is not a quote, then we have a problem." self step. "to handle eof" string := self scanBackFrom: tokenStart. "the whole token, including ' (and #')" - ^ RBErrorToken + ^ ASTErrorToken value: string start: tokenStart cause: 'Unmatched '' in string literal.' @@ -524,13 +524,13 @@ RBScanner >> scanNumber [ self step. string := self scanBackFrom: start. gotError ifNotNil: [ - ^ RBErrorToken + ^ ASTErrorToken value: string start: tokenStart cause: gotError location: stop+1 ]. - ^RBNumberLiteralToken + ^ASTNumberLiteralToken value: number start: start stop: stop @@ -549,12 +549,12 @@ RBScanner >> scanSpecialCharacter [ ^ currentCharacter = $= ifTrue: [ self step. - RBAssignmentToken start: tokenStart] - ifFalse: [ RBSpecialCharacterToken value: $: start: tokenStart ]]. + ASTAssignmentToken start: tokenStart] + ifFalse: [ ASTSpecialCharacterToken value: $: start: tokenStart ]]. character := currentCharacter. self step. - ^ RBSpecialCharacterToken value: character start: tokenStart + ^ ASTSpecialCharacterToken value: character start: tokenStart ] { #category : 'private - scanning' } @@ -591,7 +591,7 @@ RBScanner >> scanSymbolOrNamedLiteral [ self scanSymbolContent. text := buffer contents. (self scanNamedLiteral: text) ifNotNil: [ :token | ^ token ]. - ^ RBLiteralToken + ^ ASTLiteralToken value: text asSymbol start: tokenStart stop: self previousStepPosition @@ -603,7 +603,7 @@ RBScanner >> 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 = #eof ifTrue: [ ^ RBEOFToken start: tokenStart + 1 ]. "The EOF token should occur after the end of input" + characterType = #eof ifTrue: [ ^ ASTEOFToken start: tokenStart + 1 ]. "The EOF token should occur after the end of input" characterType = #alphabetic ifTrue: [ ^ state = #literalArray ifTrue: [self scanSymbolOrNamedLiteral] diff --git a/src/BaselineOfBasicTools/BaselineOfBasicTools.class.st b/src/BaselineOfBasicTools/BaselineOfBasicTools.class.st index 1aa7f7951a3..9c993845024 100644 --- a/src/BaselineOfBasicTools/BaselineOfBasicTools.class.st +++ b/src/BaselineOfBasicTools/BaselineOfBasicTools.class.st @@ -139,6 +139,21 @@ BaselineOfBasicTools >> postload: loader package: packageSpec [ ASTTemporariesErrorNode deprecatedAliases: { #RBTemporariesErrorNode }. ASTInvalidCascadeErrorNode deprecatedAliases: { #RBInvalidCascadeErrorNode }. ASTParseErrorNode deprecatedAliases: { #RBParseErrorNode }. + + ASTCommentToken deprecatedAliases: { #RBCommentToken}. + ASTLiteralToken deprecatedAliases: { #RBLiteralToken}. + ASTSpecialCharacterToken deprecatedAliases: { #RBSpecialCharacterToken}. + ASTIdentifierToken deprecatedAliases: { #RBIdentifierToken}. + ASTNumberLiteralToken deprecatedAliases: { #RBNumberLiteralToken}. + ASTToken deprecatedAliases: { #RBToken}. + ASTBinarySelectorToken deprecatedAliases: { #RBBinarySelectorToken}. + ASTKeywordToken deprecatedAliases: { #RBKeywordToken}. + ASTAssignmentToken deprecatedAliases: { #RBAssignmentToken}. + ASTErrorToken deprecatedAliases: { #RBErrorToken}. + ASTValueToken deprecatedAliases: { #RBValueToken}. + ASTEOFToken deprecatedAliases: { #RBEOFToken}. + ASTLiteralArrayToken deprecatedAliases: { #RBLiteralArrayToken}. + ASTPatternBlockToken deprecatedAliases: { #RBPatternBlockToken}. ASTPatternMessageNode deprecatedAliases: { #RBPatternMessageNode }. ASTPatternBlockNode deprecatedAliases: { #RBPatternBlockNode }. From 70e902f86e79365abedf1b82d60135a42749699a Mon Sep 17 00:00:00 2001 From: CyrilFerlicot Date: Tue, 17 Sep 2024 14:03:54 +0200 Subject: [PATCH 2/2] Update more references --- src/AST-Core/ASTAssignmentToken.class.st | 2 +- src/AST-Core/ASTBinarySelectorToken.class.st | 2 +- src/AST-Core/ASTIdentifierToken.class.st | 2 +- src/AST-Core/ASTSpecialCharacterToken.class.st | 2 +- src/AST-Core/ASTToken.class.st | 2 +- src/AST-Core/ASTValueToken.class.st | 2 +- src/AST-Core/ASTVariableNode.class.st | 2 +- src/AST-Core/RBParser.class.st | 4 ++-- src/AST-Core/RBScanner.class.st | 8 ++++---- 9 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/AST-Core/ASTAssignmentToken.class.st b/src/AST-Core/ASTAssignmentToken.class.st index 377e1f2b3d1..29590af5eb1 100644 --- a/src/AST-Core/ASTAssignmentToken.class.st +++ b/src/AST-Core/ASTAssignmentToken.class.st @@ -1,5 +1,5 @@ " -RBAssignmentToken is the first-class representation of the assignment token ':=' +ASTAssignmentToken is the first-class representation of the assignment token ':=' " Class { diff --git a/src/AST-Core/ASTBinarySelectorToken.class.st b/src/AST-Core/ASTBinarySelectorToken.class.st index acbae78285d..204706d7440 100644 --- a/src/AST-Core/ASTBinarySelectorToken.class.st +++ b/src/AST-Core/ASTBinarySelectorToken.class.st @@ -1,5 +1,5 @@ " -RBBinarySelectorToken is the first-class representation of a binary selector (e.g. +) +ASTBinarySelectorToken is the first-class representation of a binary selector (e.g. +) " Class { diff --git a/src/AST-Core/ASTIdentifierToken.class.st b/src/AST-Core/ASTIdentifierToken.class.st index de174c2bf2c..733d11f19b9 100644 --- a/src/AST-Core/ASTIdentifierToken.class.st +++ b/src/AST-Core/ASTIdentifierToken.class.st @@ -1,5 +1,5 @@ " -RBIdentifierToken is the first-class representation of an identifier token (e.g. Class) +ASTIdentifierToken is the first-class representation of an identifier token (e.g. Class) " Class { diff --git a/src/AST-Core/ASTSpecialCharacterToken.class.st b/src/AST-Core/ASTSpecialCharacterToken.class.st index 04a53f261b7..3045d128e21 100644 --- a/src/AST-Core/ASTSpecialCharacterToken.class.st +++ b/src/AST-Core/ASTSpecialCharacterToken.class.st @@ -1,5 +1,5 @@ " -RBSpecialCharacterToken is the first-class representation of special characters. +ASTSpecialCharacterToken is the first-class representation of special characters. " diff --git a/src/AST-Core/ASTToken.class.st b/src/AST-Core/ASTToken.class.st index dfb33db190e..df3e9cbecb4 100644 --- a/src/AST-Core/ASTToken.class.st +++ b/src/AST-Core/ASTToken.class.st @@ -1,5 +1,5 @@ " -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. +ASTToken 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 diff --git a/src/AST-Core/ASTValueToken.class.st b/src/AST-Core/ASTValueToken.class.st index 5320d723c8f..b7cac352a0c 100644 --- a/src/AST-Core/ASTValueToken.class.st +++ b/src/AST-Core/ASTValueToken.class.st @@ -1,5 +1,5 @@ " -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. $+). +ASTValueToken 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 diff --git a/src/AST-Core/ASTVariableNode.class.st b/src/AST-Core/ASTVariableNode.class.st index 564a3f4351a..bd9697a0229 100644 --- a/src/AST-Core/ASTVariableNode.class.st +++ b/src/AST-Core/ASTVariableNode.class.st @@ -6,7 +6,7 @@ by the parser for all variables that aren't special builtin types like self/supe just ASTVariableNodes until the semantic analyser can deduce the type. Instance Variables: - name the variable's name I represent + name the variable's name I represent nameStart the position where I was found at the source code " diff --git a/src/AST-Core/RBParser.class.st b/src/AST-Core/RBParser.class.st index 6798bce6e23..114aafcc508 100644 --- a/src/AST-Core/RBParser.class.st +++ b/src/AST-Core/RBParser.class.st @@ -2,10 +2,10 @@ 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. + 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. + 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) diff --git a/src/AST-Core/RBScanner.class.st b/src/AST-Core/RBScanner.class.st index 5c15ad88ed3..4916b1bb06d 100644 --- a/src/AST-Core/RBScanner.class.st +++ b/src/AST-Core/RBScanner.class.st @@ -9,7 +9,7 @@ Instance Variables: 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. - nextToken The ""free"" `next` token, used to store bad comment so no backtracking is needed + nextToken The ""free"" `next` token, used to store bad comment so no backtracking is needed currentCharacter The character currently being processed. extendedLiterals True if IBM-type literals are allowed. In VW, this is false. nameSpaceCharacter The character used to separate namespaces. @@ -325,8 +325,8 @@ RBScanner >> scanBackFrom: start [ { #category : 'private - scanning' } RBScanner >> scanBinary: aClass [ - "This method isn't supposed to be used in a public context as it accepts any kind of RBValueToken. - The only 2 tokens supposed to be used are RBLiteralToken and RBBinarySelectorToken." + "This method isn't supposed to be used in a public context as it accepts any kind of ASTValueToken. + The only 2 tokens supposed to be used are ASTLiteralToken and ASTBinarySelectorToken." "This method trims separators but doesn't add comments to the token created." @@ -539,7 +539,7 @@ RBScanner >> scanNumber [ { #category : 'private - scanning' } RBScanner >> scanSpecialCharacter [ - "Every given character gives a RBSpecialCharacterToken with only one character as value except for + "Every given character gives an ASTSpecialCharacterToken with only one character as value except for : followed by = which gives an assignement." "The case of the assignement is the only one consuming more than 1 character." | character |