The Trunk: ShoutCore-ul.67.mcz

Levente Uzonyi uploaded a new version of ShoutCore to project The Trunk:
http://source.squeak.org/trunk/ShoutCore-ul.67.mcz

==================== Summary ====================

Name: ShoutCore-ul.67
Author: ul
Time: 22 July 2019, 8:39:17.572145 pm
UUID: 67bd95d8-0d85-4d8c-aa12-d8000a2508bb
Ancestors: ShoutCore-ul.65

vVarious refactorings and fixes:
- renamed #rangeType: and #rangeType:start:end: to #addRangeType: and #addRangeType:start:end:
- renamed #resolve: and #resolvePartial: to #parseIdentifier and #parsePartialIdentifier
- renamed #skipBigDigits: and #isBigDigit:base: to #skipDigitsBase: and #isDigit:base:
- renamed #pushTemporary: and #pushArgument: to #parseTemporary: and #parseArgument: as those methods do actual parsing
- renamed #error to #fail to be consistent with #failWhen: and #failUnless:
- introduced #currentTokenType as an instance variable which is lazily initialized by the method of the same name. It categorizes the current token and therefore replaces various #is* methods.
- arguments and temporaries are OrderedCollections instead of Dictionaries. Each element of these collections holds the variables for the scope at the given level. This also replaces blockDepth.
- unified method and block temporary parsing into #parseTemporaries. This also fixes various issues with empty temporary lists.
- detect reserved keywords as invalid in arguments and temporaries
- detect when assignment to reserved keywords is attempted
- detect arguments and temporaries trying to shadow each other

=============== Diff against ShoutCore-ul.65 ===============

Item was changed:
  Object subclass: #SHParserST80
+ instanceVariableNames: 'classOrMetaClass source workspace arguments sourcePosition currentToken currentTokenFirst temporaries instanceVariables errorBlock currentTokenSourcePosition bracketDepth ranges environment allowUnderscoreAssignments allowUnderscoreSelectors allowBlockArgumentAssignment parseAMethod currentTokenType'
- instanceVariableNames: 'classOrMetaClass source workspace arguments sourcePosition currentToken currentTokenFirst temporaries instanceVariables errorBlock currentTokenSourcePosition blockDepth bracketDepth ranges environment allowUnderscoreAssignments allowUnderscoreSelectors parseAMethod'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'ShoutCore-Parsing'!
 
+ !SHParserST80 commentStamp: 'ul 7/18/2019 21:12' prior: 0!
- !SHParserST80 commentStamp: 'tween 8/16/2004 15:44' prior: 0!
  I am a Smalltalk method / expression parser.
 
  Rather than creating an Abstract Syntax Tree, I create a sequence of SHRanges (in my 'ranges' instance variable), which represent the tokens within the String I am parsing.
 
  I am used by a SHTextStylerST80 to parse method source strings.
  I am able to parse incomplete / incorrect methods, and so can be used to parse methods that are being edited.
 
+ Instance Variables
+ allowBlockArgumentAssignment: <Boolean>
+ allowUnderscoreAssignments: <Boolean>
+ allowUnderscoreSelectors: <Boolean>
+ arguments: <OrderedCollection<OrderedCollection<String>|nil>
+ bracketDepth: <Integer>
+ classOrMetaClass: <Class|nil>
+ currentToken: <String|nil>
+ currentTokenFirst: <Character>
+ currentTokenSourcePosition: <Integer|nil>
+ currentTokenType: <Symbol|nil>
+ environment: <Environment>
+ errorBlock: <Block>
+ instanceVariables: <Array>
+ parseAMethod: <Boolean>
+ ranges: <OrderedCollection<SHRange>>
+ source: <String>
+ sourcePosition: <Integer>
+ temporaries: <OrderedCollection<OrderedCollection<String>|nil>
+ workspace: <Workspace|nil>
- My 'source' instance variable should be set to the string to be parsed.
 
+ allowBlockArgumentAssignment
+ The value cached at the beginning of parsing of Scanner allowBlockArgumentAssignment.
- My 'classOrMetaClass' instance var must be set to the class or metaClass for the method source so that I can correctly resolve identifiers within the source. If this is nil , I parse the source as an expression (i.e. a doIt expression).
 
+ allowUnderscoreAssignments
+ The value cached at the beginning of parsing of Scanner allowUnderscoreAsAssignment.
- My 'workspace' instance variable can be set to a Workspace, so that I can resolve workspace variables.
 
+ allowUnderscoreSelectors
+ The value cached at the beginning of parsing of Scanner prefAllowUnderscoreSelectors.
- My 'environment' instance variable is the global namespace (this is initialized to Smalltalk, but can be set to a different environment).
 
+ arguments
+ This OrderedCollection has an element for each scope encapsulating the current scope.
+ The current scope's arguments are stored in the last element. The first element holds the outermost scope's arguments.
+ Each element is nil when the corresponding scope doesn't have any arguments, and the element is an OrderedCollection with the names of the arguments declared at the given scope when there's at least one.
+ The size of this variable is the same as the size of temporaries.
+
+ bracketDepth
+ Stores the number of unclosed brackets "("  and parentheses "[" before the current sourcePosition.
+
+ classOrMetaClass
+ The Class or MetaClass instance, class and pool variables should be looked up during parsing or nil when not parsing code in the context of a class (e.g. when parsing code written in a Workspace). Having this set doesn't mean a method is being parsed.
+
+ currentToken
+ The token being analyzed for which the next range should be created for.
+
+ currentTokenFirst
+ The first character of currentToken cached for quick access or a space character when there are no more tokens to parse.
+ Being always a Character helps avoiding extra checks.
+
+ currentTokenSourcePosition
+ The position of source the current token starts at or nil when there are no more tokens to process.
+
+ currentTokenType
+ The type of the current token calculated lazily by #currentTokenType. When it has been calculated, Its value is one of #keyword, #assignment, #ansiAssignment, #binary, #name, #other and occasionally #invalid.
+
+ environment
+ The Environment globals and classes should be looked up at during parsing when classOrMetaClass is nil. Its value is Smalltalk globals by default.
+
+ errorBlock
+ A block used to quickly stop parsing in case of an unrecoverable parse error.
+
+ instanceVariables
+ An Array with the instance variable names of classOrMetaClass or an empty Array when classOrMetaClass is nil.
+
+ parseAMethod
+ A way to tell the parser to parse source as a code snippet instead of a method. Mainly used by inspectors.
+
+ ranges
+ The SHRanges parsed by the parser.
+
+ source
+ The source code as a String to be parsed.
+
+ sourcePosition
+ souce is treated as a stream by the parser. This variable stores the stream position.
+
+ temporaries
+ This OrderedCollection has an element for each scope encapsulating the current scope.
+ The current scope's temporaries are stored in the last element. The first element holds the outermost scope's temporaries.
+ Each element is nil when the corresponding scope doesn't have any temporary variables, and the element is an OrderedCollection with the names of the temporaries declared at the given scope when there's at least one.
+ The size of this variable is the same as the size of arguments.
+
+ workspace
+ The Workspace in whose context variables should be looked up during parsing or nil when not parsing code in a workspace.
+
+
+ Example (explore it):
+
- Example 1.
  ranges := SHParserST80 new
  classOrMetaClass: Object;
  source: 'testMethod ^self';
  parse;
  ranges
 
+ Benchmark (print it):
+
+ SHParserST80 benchmark!
- !

Item was added:
+ ----- Method: SHParserST80 class>>benchmark (in category 'benchmarking') -----
+ benchmark
+
+ | methods methodCount totalTime averageTime min median percentile80 percentile95 percentile99 max |
+ Smalltalk garbageCollect.
+ methods := OrderedCollection new: 100000.
+ CurrentReadOnlySourceFiles cacheDuring: [
+ | parser |
+ parser := SHParserST80 new.
+ SystemNavigation default allSelectorsAndMethodsDo: [ :class :selector :method |
+ | source start ranges |
+ source := method getSource asString.
+ start := Time primUTCMicrosecondClock.
+ ranges := parser
+ rangesIn: source
+ classOrMetaClass: class
+ workspace: nil
+ environment: nil.
+ methods addLast: { Time primUTCMicrosecondClock - start. method. ranges size } ] ].
+ methods sort: #first asSortFunction.
+ methodCount := methods size.
+ totalTime := methods detectSum: #first.
+ averageTime := (totalTime / methodCount) rounded.
+
+ min := methods first.
+ median := methods at: methodCount // 2.
+ percentile80 := methods at: (methodCount * 0.8) floor.
+ percentile95 := methods at: (methodCount * 0.95) floor.
+ percentile99 := methods at: (methodCount * 0.99) floor.
+ max := methods last.
+ ^'
+ Methods {1}
+ Total {2}ms
+ Average {3}ms
+ Min {4}ms {5} range(s) ({6})
+ Median {7}ms {8} ranges ({9})
+ 80th percentile {10}ms {11} ranges ({12})
+ 95th percentile {13}ms {14} ranges ({15})
+ 99th percentile {16}ms {17} ranges ({18})
+ Max {19}ms {20} ranges ({21})' format: ({
+ methodCount asString.
+ totalTime.
+ averageTime.
+ min first.
+ min third asString.
+ min second reference.
+ median first.
+ median third asString.
+ median second reference.
+ percentile80 first.
+ percentile80 third asString.
+ percentile80 second reference.
+ percentile95 first.
+ percentile95 third asString.
+ percentile95 second reference.
+ percentile99 first.
+ percentile99 third asString.
+ percentile99 second reference.
+ max first.
+ max third asString.
+ max second reference } replace: [ :each |
+ each isNumber
+ ifTrue: [ (each / 1000) printShowingDecimalPlaces: 3 ]
+ ifFalse: [ each ] ])!

Item was added:
+ ----- Method: SHParserST80>>addRangeType: (in category 'recording ranges') -----
+ addRangeType: aSymbol
+
+ ^self
+ addRangeType: aSymbol
+ start: currentTokenSourcePosition
+ end: currentTokenSourcePosition + currentToken size - 1!

Item was added:
+ ----- Method: SHParserST80>>addRangeType:start:end: (in category 'recording ranges') -----
+ addRangeType: aSymbol start: s end: e
+
+ ^ranges addLast: (SHRange start: s end: e type: aSymbol)!

Item was added:
+ ----- Method: SHParserST80>>currentTokenType (in category 'parse support') -----
+ currentTokenType
+ "Cache and return the type of currentToken of #(name keyword binary assignment ansiAssignment other)"
+
+ ^currentTokenType ifNil: [
+ currentTokenType := currentToken ifNotNil: [
+ currentTokenFirst isLetter
+ ifFalse: [
+ currentTokenFirst == $_
+ ifTrue: [
+ (allowUnderscoreSelectors
+ and: [ currentToken size > 1
+ and: [ currentToken last == $: ] ])
+ ifTrue: [ #keyword ]
+ ifFalse: [
+ (allowUnderscoreAssignments and: [ currentToken = '_' ]) ifTrue: [
+ #assignment ] ] ]
+ ifFalse: [
+ currentToken = ':='
+ ifTrue: [ #ansiAssignment ]
+ ifFalse: [
+ (currentToken allSatisfy: [ :each | self isSelectorCharacter: each ]) ifTrue: [ #binary ] ] ] ]
+ ifTrue: [
+ currentToken last == $:
+ ifTrue: [ #keyword ]
+ ifFalse: [
+ (currentToken last isAlphaNumeric or: [
+ allowUnderscoreSelectors and: [
+ currentToken last == $_ ] ])
+ ifTrue: [ #name ] ] ] ].
+ currentTokenType ifNil: [ currentTokenType := #other ] ]!

Item was removed:
- ----- Method: SHParserST80>>enterBlock (in category 'parse support') -----
- enterBlock
- blockDepth := blockDepth + 1.
- bracketDepth := bracketDepth + 1!

Item was removed:
- ----- Method: SHParserST80>>error (in category 'error handling') -----
- error
- self
- rangeType: #excessCode
- start: (ranges isEmpty ifTrue: [1] ifFalse: [ranges last end + 1])
- end: source size.
- errorBlock value!

Item was added:
+ ----- Method: SHParserST80>>fail (in category 'error handling') -----
+ fail
+
+ | start |
+ start := (ranges isEmpty ifTrue: [ 1 ] ifFalse: [ ranges last end + 1 ]).
+ start <= source size ifTrue: [
+ self
+ addRangeType: #excessCode
+ start: start
+ end: source size ].
+ errorBlock value!

Item was changed:
  ----- Method: SHParserST80>>failUnless: (in category 'error handling') -----
  failUnless: aBoolean
+ aBoolean ifFalse:[self fail]
- aBoolean ifFalse:[self error]
  !

Item was changed:
  ----- Method: SHParserST80>>failWhen: (in category 'error handling') -----
  failWhen: aBoolean
+ aBoolean ifTrue:[self fail]!
- aBoolean ifTrue:[self error]!

Item was removed:
- ----- Method: SHParserST80>>isAnsiAssignment (in category 'token testing') -----
- isAnsiAssignment
- ^currentToken = ':='!

Item was removed:
- ----- Method: SHParserST80>>isAssignment (in category 'token testing') -----
- isAssignment
-
- self isAnsiAssignment ifTrue: [ ^true ].
- ^allowUnderscoreAssignments and: [ currentToken = '_' ]!

Item was removed:
- ----- Method: SHParserST80>>isBigDigit:base: (in category 'character testing') -----
- isBigDigit: aCharacter base: anInteger
-     "Answer true if aCharacter is a digit or a capital
-     letter appropriate for base anInteger"
- | digitValue |
-
- digitValue := aCharacter digitValue.
- ^digitValue >= 0 and:[digitValue < anInteger]!

Item was removed:
- ----- Method: SHParserST80>>isBinary (in category 'token testing') -----
- isBinary
-
- currentToken ifNil: [ ^false ].
- self isName ifTrue: [ ^false ].
- self isKeyword ifTrue: [ ^false ].
- 1 to: currentToken size do: [ :i |
- (self isSelectorCharacter: (currentToken at: i)) ifFalse: [ ^false ] ].
- ^true!

Item was removed:
- ----- Method: SHParserST80>>isBlockArgName: (in category 'identifier testing') -----
- isBlockArgName: aString
- "Answer true if aString is the name of a block argument, false otherwise"
- | temp arg |
- blockDepth to: 1 by: -1 do: [:level |
- arg := (arguments at: level ifAbsent: [#()]) includes: aString.
- arg ifTrue: [^true].
- temp := (temporaries at: level ifAbsent: [#()]) includes: aString.
- temp ifTrue: [^false]].
- ^false!

Item was removed:
- ----- Method: SHParserST80>>isBlockTempName: (in category 'identifier testing') -----
- isBlockTempName: aString
- "Answer true if aString is the name of a block temporary. false otherwise"
-
- | temp arg |
- blockDepth to: 1 by: -1 do: [:level |
- arg := (arguments at: level ifAbsent: [#()]) includes: aString.
- arg ifTrue: [^false].
- temp := (temporaries at: level ifAbsent: [#()]) includes: aString.
- temp ifTrue: [^true]].
- ^false!

Item was added:
+ ----- Method: SHParserST80>>isDigit:base: (in category 'character testing') -----
+ isDigit: aCharacter base: anInteger
+     "Answer true if aCharacter is a digit or a capital letter appropriate for base anInteger"
+
+ | digitValue |
+ ^(digitValue := aCharacter digitValue) >= 0 and: [
+ digitValue < anInteger ]!

Item was removed:
- ----- Method: SHParserST80>>isIncompleteBlockArgName: (in category 'identifier testing') -----
- isIncompleteBlockArgName: aString
- "Answer true if aString is the start of the name of a block argument, false otherwise"
- |  arg |
- blockDepth to: 1 by: -1 do: [:level |
- arg := (arguments at: level ifAbsent: [#()]) anySatisfy: [:each | each beginsWith: aString].
- arg ifTrue: [^true]].
- ^false!

Item was removed:
- ----- Method: SHParserST80>>isIncompleteBlockTempName: (in category 'identifier testing') -----
- isIncompleteBlockTempName: aString
- "Answer true if aString is the start of the name of a block temporary. false otherwise"
-
- | temp  |
- blockDepth to: 1 by: -1 do: [:level |
- temp := (temporaries at: level ifAbsent: [#()]) anySatisfy: [:each | each beginsWith: aString].
- temp ifTrue: [^true]].
- ^false!

Item was removed:
- ----- Method: SHParserST80>>isIncompleteMethodArgName: (in category 'identifier testing') -----
- isIncompleteMethodArgName: aString
- "Answer true if aString is the start of the name of a method argument, false otherwise.
-     Does not check whether aString is also a blockArgName"
-
- ^(arguments at: 0 ifAbsent: [#()]) anySatisfy: [:each | each beginsWith: aString]!

Item was removed:
- ----- Method: SHParserST80>>isIncompleteMethodTempName: (in category 'identifier testing') -----
- isIncompleteMethodTempName: aString
- "Answer true if aString is the start of then name of a method temporary, false otherwise."
-
- ^(temporaries at: 0 ifAbsent: [#()]) anySatisfy: [:each | each beginsWith: aString]!

Item was removed:
- ----- Method: SHParserST80>>isKeyword (in category 'token testing') -----
- isKeyword
- "This method assumes that currentTokenFirst is a non-letter character when currentToken is nil."
-
- currentTokenFirst isLetter ifTrue: [
- ^currentToken last == $: ].
- ^allowUnderscoreSelectors
- and: [ currentTokenFirst == $_
- and: [ currentToken notNil
- and: [ currentToken size > 1
- and: [ currentToken last == $: ] ] ] ]!

Item was removed:
- ----- Method: SHParserST80>>isMethodArgName: (in category 'identifier testing') -----
- isMethodArgName: aString
- "Answer true if aString is the name of a method argument, false otherwise.
-     Does not check whether aString is also a blockArgName"
-
- ^(arguments at: 0 ifAbsent: [#()]) includes: aString!

Item was removed:
- ----- Method: SHParserST80>>isMethodTempName: (in category 'identifier testing') -----
- isMethodTempName: aString
- "Answer true if aString is the name of a method temporary, false otherwise.
-     Does not check whether aString is also a block temporary
-     or argument"
-
- ((arguments at: 0 ifAbsent: [#()]) includes: aString) ifTrue: [^false].
- ^(temporaries at: 0 ifAbsent: [#()]) includes: aString!

Item was removed:
- ----- Method: SHParserST80>>isName (in category 'token testing') -----
- isName
- "This method assumes that currentTokenFirst is a non-letter character when currentToken is nil."
-
- ^(currentTokenFirst isLetter
- or: [ allowUnderscoreSelectors
- and: [ currentTokenFirst == $_
- and: [ currentToken notNil
- and: [ currentToken size > 1 ] ] ] ])
- and: [ currentToken last isAlphaNumeric
- or: [ allowUnderscoreSelectors
- and: [ currentToken last == $_ ] ] ] !

Item was changed:
  ----- Method: SHParserST80>>isTokenExternalFunctionCallingConvention (in category 'token testing') -----
  isTokenExternalFunctionCallingConvention
+
+ currentToken ifNil: [ ^false ].
+ ^(Smalltalk classNamed: #ExternalFunction)
+ ifNil: [ false ]
+ ifNotNil: [ :descriptorClass |
+ (descriptorClass callingConventionFor: currentToken) notNil ]!
- | descriptorClass |
- descriptorClass := Smalltalk at: #ExternalFunction ifAbsent: [nil].
- descriptorClass == nil ifTrue: [^false].
- ^(descriptorClass callingConventionFor: currentToken) notNil!

Item was removed:
- ----- Method: SHParserST80>>leaveBlock (in category 'parse support') -----
- leaveBlock
- arguments removeKey: blockDepth ifAbsent: [].
- temporaries removeKey: blockDepth ifAbsent: [].
- blockDepth := blockDepth - 1.
- bracketDepth := bracketDepth - 1!

Item was changed:
  ----- Method: SHParserST80>>parse: (in category 'parse') -----
  parse: isAMethod
  "Parse the receiver's text. If isAMethod is true
      then treat text as a method, if false as an
      expression with no message pattern"
 
  self initializeInstanceVariables.
  allowUnderscoreAssignments := Scanner allowUnderscoreAsAssignment.
  allowUnderscoreSelectors := Scanner prefAllowUnderscoreSelectors.
+ allowBlockArgumentAssignment := Scanner allowBlockArgumentAssignment.
  sourcePosition := 1.
+ arguments
+ ifNil: [ arguments := OrderedCollection with: nil ]
+ ifNotNil: [ arguments reset; addLast: nil ].
+ temporaries
+ ifNil: [ temporaries := OrderedCollection with: nil ]
+ ifNotNil: [ temporaries reset; addLast: nil ].
+ bracketDepth := 0.
- arguments := Dictionary new.
- temporaries := Dictionary new.
- blockDepth := bracketDepth := 0.
  ranges
  ifNil: [ ranges := OrderedCollection new: 40 "Covers over 80% of all methods." ]
  ifNotNil: [ ranges reset ].
  errorBlock := [^false].
  self scanNext.
  isAMethod ifTrue: [
  self
  parseMessagePattern;
  parsePragmaSequence ].
+ self parseTemporaries.
- self parseMethodTemporaries.
  isAMethod ifTrue: [ self parsePragmaSequence ].
  self parseStatementList.
+ currentToken ifNotNil: [ self fail ].
- currentToken ifNotNil: [ self error ].
  ^true!

Item was added:
+ ----- Method: SHParserST80>>parseArgument: (in category 'parse') -----
+ parseArgument: expectedArgumentType
+ "Add currentToken to the current scope as argument. Scan past expectedArgumentType if the argument is valid."
+
+ self currentTokenType == #name ifFalse: [ self fail ": name expected" ].
+ (self reservedKeywordNames includes: currentToken) ifTrue: [
+ "Reserved keyword"
+ ^self scanPast: #invalid ].
+
+ 1 to: arguments size do: [ :index |
+ (arguments at: index) ifNotNil: [ :scopeArguments |
+ (scopeArguments includes: currentToken) ifTrue: [
+ "Name is already used."
+ ^self scanPast: #invalid ] ].
+ (temporaries at: index) ifNotNil: [ :scopeTemporaries |
+ (scopeTemporaries includes: currentToken) ifTrue: [
+ "Name is already used."
+ ^self scanPast: #invalid ] ] ].
+
+ arguments last
+ ifNil: [ arguments atLast: 1 put: (OrderedCollection with: currentToken) ]
+ ifNotNil: [ :scopeArguments | scopeArguments addLast: currentToken ].
+ ^self scanPast: expectedArgumentType!

Item was changed:
  ----- Method: SHParserST80>>parseBinary (in category 'parse') -----
  parseBinary
+
- | binary type |
  self parseUnary.
+ [ self currentTokenType == #binary ]
- [self isBinary]
  whileTrue: [
+ self scanPast: (
+ (Symbol lookup: currentToken)
+ ifNotNil: [ #binary ]
+ ifNil: [
+ (Symbol thatStartsCaseSensitive: currentToken skipping: nil)
+ ifNil: [ #undefinedBinary ]
+ ifNotNil:[ #incompleteBinary ] ]).
+ self
+ parseTerm;
+ parseUnary ]!
- binary := currentToken.
- type := #binary.
- (binary isEmpty or:[(Symbol lookup: binary) notNil])
- ifFalse:[
- type := (Symbol thatStartsCaseSensitive: binary skipping: nil)
- ifNil: [#undefinedBinary]
- ifNotNil:[#incompleteBinary]].
- self scanPast: type.
- self parseTerm.
-             self parseUnary]
- !

Item was changed:
  ----- Method: SHParserST80>>parseBinaryMessagePattern (in category 'parse') -----
+ parseBinaryMessagePattern
- parseBinaryMessagePattern  
 
+ self
+ scanPast: #patternBinary;
+ parseArgument: #patternArg!
-     self scanPast:  #patternBinary.
- self failUnless: self isName.
- self scanPast: #patternArg.
-
- !

Item was changed:
  ----- Method: SHParserST80>>parseBlock (in category 'parse') -----
  parseBlock
+
+ arguments addLast: nil.
+ temporaries addLast: nil.
+ bracketDepth := bracketDepth + 1.
+ self
+ scanPastBracket: #blockStart;
+ parseBlockArguments;
+ parseTemporaries;
+ parseStatementList;
+ failUnless: currentTokenFirst == $];
+ scanPastBracket: #blockEnd.
+ bracketDepth := bracketDepth - 1.
+ arguments removeLast.
+ temporaries removeLast!
- self enterBlock.
- self scanPast: #blockStart level: bracketDepth.
- currentTokenFirst == $: ifTrue: [self parseBlockArguments].
- currentTokenFirst == $| ifTrue: [self parseBlockTemporaries].
- self parseStatementList.
- self failUnless: currentTokenFirst == $].
- self scanPast: #blockEnd level: bracketDepth.
- self leaveBlock!

Item was changed:
  ----- Method: SHParserST80>>parseBlockArguments (in category 'parse') -----
  parseBlockArguments
+
+ currentTokenFirst == $: ifFalse: [ ^self ].
+ [ currentTokenFirst == $: ] whileTrue: [
+ self
+ scanPast: #blockArgColon;
+ parseArgument: #blockPatternArg ].
+ (self parseVerticalBarForTemporaries: #blockArgsBar) ifFalse: [
+ self fail ": Missing block args bar" ]!
- [currentTokenFirst == $:]
- whileTrue: [
- self scanPast: #blockArgColon.
- self failUnless: self isName.
- self scanPast: #blockPatternArg].
- currentTokenFirst == $|
- ifTrue: [^self scanPast: #blockArgsBar]!

Item was removed:
- ----- Method: SHParserST80>>parseBlockTemporaries (in category 'parse') -----
- parseBlockTemporaries
- currentTokenFirst == $|
- ifTrue: [
- self scanPast: #blockTempBar.
- [self isName]
- whileTrue: [self scanPast: #blockPatternTempVar].
- self failUnless: currentToken = '|'.
- self scanPast: #blockTempBar]!

Item was changed:
  ----- Method: SHParserST80>>parseByteArray (in category 'parse') -----
  parseByteArray
 
  [currentTokenFirst == $]] whileFalse: [
  currentTokenFirst isDigit
  ifTrue: [
  "do not parse the number, can be time consuming"
  self scanPast: #number]
+ ifFalse: [ self fail ] ].
- ifFalse: [
- self failWhen: currentTokenFirst == $. .
- self error]].
  self scanPast: #byteArrayEnd!

Item was changed:
  ----- Method: SHParserST80>>parseExpression (in category 'parse') -----
  parseExpression
+
+ | identifierType |
+ self currentTokenType == #name ifFalse: [
+ ^self
+ parseTerm;
+ parseCascade ].
+ self scanPast: (identifierType := self parseIdentifier).
+ (self currentTokenType == #ansiAssignment or: [ currentTokenType == #assignment ])
+ ifFalse: [ ^self parseCascade ].
+ (identifierType == #methodArg
+ or: [ (identifierType == #blockArg
+ and: [ allowBlockArgumentAssignment not ])
+ or: [ self reservedKeywordNames includes: identifierType ] ])
- | assignType |
- self isName
  ifTrue: [
+ "Cannot store into those variables."
+ currentTokenType := #invalid ].
+ self
+ scanPast: currentTokenType;
+ parseExpression!
- self scanPast: (self resolve: currentToken).
- self isAssignment
- ifTrue: [
- assignType := self isAnsiAssignment
- ifTrue: [#ansiAssignment]
- ifFalse: [#assignment].
- self scanPast: assignType.
- self parseExpression]
- ifFalse: [self parseCascade]]
- ifFalse: [
- self parseTerm.
- self parseCascade]!

Item was changed:
  ----- Method: SHParserST80>>parseExternalCall (in category 'parse') -----
  parseExternalCall
  [self scanNext.
  ((Smalltalk at: #ExternalFunction) callingConventionModifierFor: currentToken) notNil]
  whileTrue.
  self failUnless: currentToken notNil.
  self scanPast: #externalCallType.
  currentToken = '*'
  ifTrue: [self scanPast: #externalCallTypePointerIndicator].
  currentTokenFirst isDigit
  ifTrue: [self scanPast: #integer]
  ifFalse: [
  self failUnless: currentTokenFirst == $'.
  self parseString].
  self failUnless: currentTokenFirst == $(.
  self scanPast: #leftParenthesis.
  [currentTokenFirst ~= $)]
  whileTrue: [
  self failUnless: currentToken notNil.
  self scanPast: #externalCallType.
  currentToken = '*'
  ifTrue: [self scanPast: #externalCallTypePointerIndicator]].
  self scanPast: #rightParenthesis.
  currentToken = 'module:'
  ifTrue: [
  self scanPast: #module.
  self parseStringOrSymbol ].
  currentToken = 'error:' ifTrue: [
  self scanPast: #primitive. "there's no rangeType for error"
+ self currentTokenType == #name
+ ifTrue: [ self parseTemporary: #patternTempVar ]
- self isName
- ifTrue: [ self scanPast: #patternTempVar ]
  ifFalse: [ self parseStringOrSymbol ] ].
  self failUnless: currentToken = '>'.
  self scanPast: #primitiveOrExternalCallEnd!

Item was added:
+ ----- Method: SHParserST80>>parseIdentifier (in category 'identifier testing') -----
+ parseIdentifier
+ "currentToken is either a name of an existing variable, a prefix of a variable or an undefined identifier. Return the appropriate range type for it."
+
+ currentToken = #self ifTrue: [ ^#self ].
+ currentToken = #true ifTrue: [ ^#true ].
+ currentToken = #false ifTrue: [ ^#false ].
+ currentToken = #nil ifTrue: [ ^#nil ].
+ currentToken = #super ifTrue: [ ^#super ].
+ currentToken = #thisContext ifTrue: [ ^#thisContext ].
+
+ arguments size to: 1 by: -1 do: [ :level |
+ (arguments at: level) ifNotNil: [ :levelArguments |
+ (levelArguments includes: currentToken) ifTrue: [
+ ^level = 1
+ ifTrue: [ #methodArg ]
+ ifFalse: [ #blockArg ] ] ].
+ (temporaries at: level) ifNotNil: [ :levelTemporaries |
+ (levelTemporaries includes: currentToken) ifTrue: [
+ ^level = 1
+ ifTrue: [ #tempVar ]
+ ifFalse: [ #blockTempVar ] ] ] ].
+
+ (instanceVariables includes: currentToken) ifTrue: [^#instVar].
+
+ workspace
+ ifNotNil: [(workspace hasBindingOf: currentToken) ifTrue: [^#workspaceVar]].
+
+ (Symbol lookup: currentToken) ifNotNil: [:sym |
+ classOrMetaClass
+ ifNotNil: [
+ classOrMetaClass theNonMetaClass withAllSuperclassesDo: [:c |
+ (c classPool bindingOf: sym) ifNotNil: [^#classVar].
+ c sharedPools do: [:p | (p bindingOf: sym) ifNotNil: [^#poolConstant]].
+ (c environment bindingOf: sym) ifNotNil: [^#globalVar]]]
+ ifNil: [(environment bindingOf: sym) ifNotNil: [^#globalVar]]].
+ ^self parsePartialIdentifier!

Item was changed:
  ----- Method: SHParserST80>>parseKeyword (in category 'parse') -----
+ parseKeyword
+
+ | keyword rangeIndices |
+ self parseBinary.
+ self currentTokenType == #keyword ifFalse: [ ^self ].
- parseKeyword
-     | keyword rangeIndices |
-     self parseBinary.
- keyword := ''.
- rangeIndices := #().
  [
+ keyword := currentToken.
+ self addRangeType: #keyword.
+ rangeIndices := { ranges size }.
+ self
+ scanNext;
+ parseTerm;
+ parseBinary.
+     [self currentTokenType == #keyword]
-     [self isKeyword]
          whileTrue: [
  keyword := keyword, currentToken.
+ self addRangeType: #keyword.
- self rangeType: #keyword.
  "remember where this keyword token is in ranges"
  rangeIndices := rangeIndices copyWith: ranges size.
+ self
+ scanNext;
+ parseTerm;
+ parseBinary ]
- self scanNext.
- self parseTerm.
- self parseBinary ]
  ] ensure: [ | type |
  "do this in an ensure so that it happens even if the errorBlock evaluates before getting here"
  "patch up the keyword tokens, so that incomplete and undefined ones look different"
  (keyword isEmpty or:[(Symbol lookup: keyword) notNil])
  ifFalse:[
  type := (Symbol thatStartsCaseSensitive: keyword skipping: nil)
  ifNil: [#undefinedKeyword]
  ifNotNil:[#incompleteKeyword].
  rangeIndices do: [:i | (ranges at: i) type: type]]]!

Item was changed:
  ----- Method: SHParserST80>>parseKeywordMessagePattern (in category 'parse') -----
  parseKeywordMessagePattern  
 
+ [ self currentTokenType == #keyword ] whileTrue: [
+ self
+ scanPast: #patternKeyword;
+ parseArgument: #patternArg ]!
- [self isKeyword]
- whileTrue: [
- self scanPast:  #patternKeyword.
- self failUnless: self isName.
- self scanPast: #patternArg]
-
- !

Item was changed:
  ----- Method: SHParserST80>>parseLiteral: (in category 'parse') -----
  parseLiteral: inArray
 
  currentTokenFirst == $$
  ifTrue: [
  | pos |
  self failWhen: self currentChar isNil.
+ self addRangeType: #'$'.
- self rangeType: #'$'.
  pos := currentTokenSourcePosition + 1.
  self nextChar.
  ^self scanPast: #character start: pos end: pos].
  currentTokenFirst isDigit
  ifTrue: [
  "do not parse the number, can be time consuming"
  ^self scanPast: #number].
  currentToken = '-'
  ifTrue: [
  | c |
  c := self currentChar.
  (inArray and: [c isNil or: [ c isDigit not ]])
  ifTrue: [
  "single - can be a symbol in an Array"
  ^self scanPast: #symbol].
  self scanPast: #-.
  self failWhen: currentToken isNil.
+ "token isNil ifTrue: [self fail: 'Unexpected End Of Input']."
- "token isNil ifTrue: [self error: 'Unexpected End Of Input']."
  "do not parse the number, can be time consuming"
  ^self scanPast: #number].
  currentTokenFirst == $' ifTrue: [^self parseString].
  currentTokenFirst == $# ifTrue: [^self parseSymbol].
  (inArray and: [currentToken notNil]) ifTrue: [^self scanPast: #symbol].
+ self fail ": 'argument missing'"!
- self failWhen: currentTokenFirst == $. .
- self error ": 'argument missing'"!

Item was changed:
  ----- Method: SHParserST80>>parseMessagePattern (in category 'parse') -----
  parseMessagePattern  
 
+ self currentTokenType
+ caseOf: {
+ [ #name ] -> [ self parseUnaryMessagePattern ].
+ [ #binary ] -> [ self parseBinaryMessagePattern ].
+ [ #keyword ] -> [ self parseKeywordMessagePattern ] }
+ otherwise: [ self fail ]!
- self isName
- ifTrue: [self parseUnaryMessagePattern]
- ifFalse: [
- self isBinary
- ifTrue:[self parseBinaryMessagePattern]
- ifFalse:[
- self failUnless: self isKeyword.
- self parseKeywordMessagePattern]]!

Item was removed:
- ----- Method: SHParserST80>>parseMethodTemporaries (in category 'parse') -----
- parseMethodTemporaries
- currentTokenFirst == $|
- ifTrue: [
- self scanPast: #methodTempBar.
- [self isName]
- whileTrue: [self scanPast: #patternTempVar].
- self failUnless: currentToken = '|'.
- self scanPast: #methodTempBar]!

Item was added:
+ ----- Method: SHParserST80>>parsePartialIdentifier (in category 'identifier testing') -----
+ parsePartialIdentifier
+ "Decide whether currentToken is an #incompleteIdentifier or an #undefinedIdentifier.
+ This method has many different return statements, but only returns two range parts so far.
+ It might be changed to return different range types for different variable type prefixes."
+
+ (self reservedKeywordNames anySatisfy: [:each | each beginsWith: currentToken])
+ ifTrue: [^#incompleteIdentifier].
+
+ arguments size to: 1 by: -1 do: [ :level |
+ (arguments at: level) ifNotNil: [ :levelArguments |
+ (levelArguments anySatisfy: [ :each | each beginsWith: currentToken ]) ifTrue: [
+ ^level = 1
+ ifTrue: [ #incompleteIdentifier ]
+ ifFalse: [ #incompleteIdentifier ] ] ].
+ (temporaries at: level) ifNotNil: [ :levelTemporaries |
+ (levelTemporaries anySatisfy: [ :each | each beginsWith: currentToken ]) ifTrue: [
+ ^level = 1
+ ifTrue: [ #incompleteIdentifier ]
+ ifFalse: [ #incompleteIdentifier ] ] ] ].
+
+ (instanceVariables anySatisfy: [:each | each beginsWith: currentToken]) ifTrue: [^#incompleteIdentifier].
+
+ workspace
+ ifNotNil: [(workspace hasBindingThatBeginsWith: currentToken) ifTrue: [^#incompleteIdentifier]].
+
+ classOrMetaClass
+ ifNotNil: [
+ classOrMetaClass theNonMetaClass withAllSuperclassesDo: [:c |
+ (c classPool hasBindingThatBeginsWith: currentToken) ifTrue: [^#incompleteIdentifier].
+ c sharedPools do: [:p | (p hasBindingThatBeginsWith: currentToken) ifTrue: [^#incompleteIdentifier]].
+ (c environment hasBindingThatBeginsWith: currentToken) ifTrue: [^#incompleteIdentifier]]]
+ ifNil: [(environment hasBindingThatBeginsWith: currentToken) ifTrue: [^#incompleteIdentifier]].
+ ^#undefinedIdentifier!

Item was changed:
  ----- Method: SHParserST80>>parsePragmaBinary (in category 'parse') -----
  parsePragmaBinary
 
  self scanPast: #pragmaBinary.
+ self currentTokenType == #name
- self isName
  ifTrue:[self scanPast: (self resolvePragmaArgument: currentToken)]
  ifFalse:[ self parseLiteral: false].
  self failUnless: currentToken = '>'.
  self scanPast: #primitiveOrExternalCallEnd!

Item was changed:
  ----- Method: SHParserST80>>parsePragmaKeyword (in category 'parse') -----
  parsePragmaKeyword
 
+ [self currentTokenType == #keyword]
- [self isKeyword]
  whileTrue:[
  self scanPast: #pragmaKeyword.
+ self currentTokenType == #name
- self isName
  ifTrue:[self scanPast: (self resolvePragmaArgument: currentToken)]
  ifFalse:[ self parseLiteral: false]].
  self failUnless: currentToken = '>'.
  self scanPast: #primitiveOrExternalCallEnd!

Item was changed:
  ----- Method: SHParserST80>>parsePragmaSequence (in category 'parse') -----
  parsePragmaSequence
  [currentToken = '<' ]
  whileTrue:[
  self scanPast: #primitiveOrExternalCallStart.
  currentToken = 'primitive:'
  ifTrue: [
+ self addRangeType: #primitive.
- self rangeType: #primitive.
  self parsePrimitive]
  ifFalse:[
  self isTokenExternalFunctionCallingConvention
  ifTrue: [
+ self addRangeType: #externalFunctionCallingConvention.
- self rangeType: #externalFunctionCallingConvention.
  self parseExternalCall]
  ifFalse:[
+ self currentTokenType
+ caseOf: {
+ [ #name ] -> [
+ self scanPast: #pragmaUnary.
+ self failUnless: currentToken = '>'.
+ self scanPast: #primitiveOrExternalCallEnd ].
+ [ #binary ] -> [ self parsePragmaBinary ].
+ [ #keyword ] -> [ self parsePragmaKeyword ] }
+ otherwise: [ self fail ": 'Invalid External Function Calling convention'" ] ] ] ]!
- self isName
- ifTrue:[
- self scanPast: #pragmaUnary.
- self failUnless: currentToken = '>'.
- self scanPast: #primitiveOrExternalCallEnd]
- ifFalse:[
- self isKeyword
- ifTrue:[
- self parsePragmaKeyword]
- ifFalse:[
- self isBinary
- ifTrue:[self parsePragmaBinary]
- ifFalse:[ self error ": 'Invalid External Function Calling convention'" ]]]]]]!

Item was changed:
  ----- Method: SHParserST80>>parsePrimitive (in category 'parse') -----
  parsePrimitive
 
  self scanNext.
  currentTokenFirst isDigit
  ifTrue: [ self scanPast: #integer ]
  ifFalse: [
  self parseStringOrSymbol.
  currentToken = 'module:' ifTrue: [
  self scanPast: #module.
  self parseStringOrSymbol ] ].
  currentToken = 'error:' ifTrue: [
  self scanPast: #primitive. "there's no rangeType for error"
+ self currentTokenType == #name
+ ifTrue: [ self parseTemporary: #patternTempVar ]
- self isName
- ifTrue: [ self scanPast: #patternTempVar ]
  ifFalse: [ self parseStringOrSymbol ] ].
  self failUnless: currentToken = '>'.
  self scanPast: #primitiveOrExternalCallEnd!

Item was changed:
  ----- Method: SHParserST80>>parseString (in category 'parse') -----
  parseString
  | first c last |
  first := sourcePosition.
 
  [(c := self currentChar)
  ifNil: [
+ self
+ addRangeType: #unfinishedString start: first - 1 end: source size;
+ fail ": 'unfinished string'"].
- self rangeType: #unfinishedString start: first - 1 end: source size.
- self error ": 'unfinished string'"].
  c ~~ $' or: [
  self peekChar == $'
  ifTrue: [
  sourcePosition := sourcePosition + 1.
  true]
  ifFalse: [false]]
  ] whileTrue: [sourcePosition := sourcePosition + 1].
  last := sourcePosition.
+ self
+ nextChar;
+ scanPast: #string start: first - 1 end: last!
- self nextChar.
- self scanPast: #string start: first - 1 end: last!

Item was changed:
  ----- Method: SHParserST80>>parseStringOrSymbol (in category 'parse') -----
  parseStringOrSymbol
 
  currentTokenFirst == $' ifTrue: [ ^self parseString ].
  currentTokenFirst == $# ifTrue: [ ^self parseSymbol ].
+ self fail!
- self error!

Item was changed:
  ----- Method: SHParserST80>>parseSymbol (in category 'parse') -----
  parseSymbol
+
  | c |
+ currentToken size = 1 ifTrue: [
+ "if token is just the #, then scan whitespace and comments
+ and then process the next character.
+ Squeak allows space between the # and the start of the symbol
+ e.g. # (),  #  a, #  'sym' "
+ self
+ addRangeType: #symbol;
+ scanWhitespace ].
- currentToken = '#'
- ifTrue: [
- "if token is just the #, then scan whitespace and comments
- and then process the next character.
- Squeak allows space between the # and the start of the symbol
- e.g. # (),  #  a, #  'sym' "
- self rangeType: #symbol.
- self scanWhitespace].
  c := self currentChar.
  self failWhen: (c isNil or: [c isSeparator]).
+ c == $( ifTrue: [
+ ^self
+ nextChar;
+ scanPast: #arrayStart
+ start: currentTokenSourcePosition
+ end: currentTokenSourcePosition + 1;
+ parseArray].
- c == $(
- ifTrue: [
- self nextChar.
- self scanPast: #arrayStart start: currentTokenSourcePosition end: currentTokenSourcePosition + 1.
- ^self parseArray].
  c == $' ifTrue: [^self parseSymbolString].
  c == $[ ifTrue: [
+ ^self
+ nextChar;
+ scanPast: #byteArrayStart
+ start: currentTokenSourcePosition
+ end: currentTokenSourcePosition + 1;
+ parseByteArray ].
+ (self isSelectorCharacter: c) ifTrue: [ ^self parseSymbolSelector ].
- self nextChar.
- self scanPast: #byteArrayStart start: currentTokenSourcePosition end: currentTokenSourcePosition + 1.
- ^self parseByteArray].
- ((self isSelectorCharacter: c) or: [c == $-])
- ifTrue: [^self parseSymbolSelector].
  (c isLetter
  or: [ c == $:
+ or: [ c == $_ and: [ allowUnderscoreSelectors ] ] ])
- or: [ allowUnderscoreSelectors and: [ c == $_ ] ] ])
  ifTrue: [^self parseSymbolIdentifier].
  ^self parseCharSymbol!

Item was changed:
  ----- Method: SHParserST80>>parseSymbolString (in category 'parse') -----
  parseSymbolString
  | first c last |
  first := sourcePosition.
  self nextChar.
  [(c := self currentChar)
  ifNil: [
+ self addRangeType: #unfinishedString start: first end: source size.
+ self fail ": 'unfinished string'"].
- self rangeType: #unfinishedString start: first end: source size.
- self error ": 'unfinished string'"].
  c ~~ $' or: [
  self peekChar == $'
  ifTrue: [sourcePosition := sourcePosition + 1.true]
  ifFalse: [false]]
  ] whileTrue: [sourcePosition := sourcePosition + 1].
  last := sourcePosition.
+ self
+ nextChar;
+ scanPast: #stringSymbol start: first - 1 end: last!
- self nextChar.
- self scanPast: #stringSymbol start: first - 1 end: last!

Item was added:
+ ----- Method: SHParserST80>>parseTemporaries (in category 'parse') -----
+ parseTemporaries
+
+ | barRangeType temporaryRangeType |
+ temporaries size = 1
+ ifTrue: [
+ barRangeType := #methodTempBar.
+ temporaryRangeType := #patternTempVar ]
+ ifFalse: [
+ barRangeType := #blockTempBar.
+ temporaryRangeType := #blockPatternTempVar ].
+ (self parseVerticalBarForTemporaries: barRangeType) ifFalse: [ ^self ].
+ [ self currentTokenType == #name ] whileTrue: [
+ self parseTemporary: temporaryRangeType ].
+ (self parseVerticalBarForTemporaries: barRangeType) ifFalse: [
+ self fail ": Missing closing temp bar" ]!

Item was added:
+ ----- Method: SHParserST80>>parseTemporary: (in category 'parse') -----
+ parseTemporary: expectedTemporaryType
+ "Add currentToken to the current scope as temporary. Scan past expectedTemporaryType if the argument is valid. Assume that currentTokenType is #name."
+
+ (self reservedKeywordNames includes: currentToken) ifTrue: [
+ "Reserved keyword"
+ ^self scanPast: #invalid ].
+
+ 1 to: arguments size do: [ :index |
+ (arguments at: index) ifNotNil: [ :scopeArguments |
+ (scopeArguments includes: currentToken) ifTrue: [
+ "Name is already used."
+ ^self scanPast: #invalid ] ].
+ (temporaries at: index) ifNotNil: [ :scopeTemporaries |
+ (scopeTemporaries includes: currentToken) ifTrue: [
+ "Name is already used."
+ ^self scanPast: #invalid ] ] ].
+
+ temporaries last
+ ifNil: [ temporaries atLast: 1 put: (OrderedCollection with: currentToken) ]
+ ifNotNil: [ :scopeTemporaries | scopeTemporaries addLast: currentToken ].
+ ^self scanPast: expectedTemporaryType!

Item was changed:
  ----- Method: SHParserST80>>parseTerm (in category 'parse') -----
  parseTerm
+
+ currentToken ifNil: [ self fail ": Term expected" ].
+ currentTokenFirst == $( ifTrue: [
+ bracketDepth := bracketDepth + 1.
+ self
+ scanPastBracket: #leftParenthesis;
+ parseExpression;
+ failUnless: currentTokenFirst == $);
+ scanPastBracket: #rightParenthesis.
+ ^bracketDepth := bracketDepth - 1 ].
+ currentTokenFirst == $[ ifTrue: [
+ ^self parseBlock ].
+ currentTokenFirst == ${ ifTrue: [
+ ^self
+ scanPast: #leftBrace;
+ parseBraceArray].
+ self currentTokenType == #name ifTrue: [
+ ^self scanPast: self parseIdentifier ].
- self failWhen: currentToken isNil.
- currentTokenFirst == $(
- ifTrue: [
- bracketDepth := bracketDepth + 1.
- self scanPast: #leftParenthesis level: bracketDepth.
- self parseExpression.
- self failUnless: currentTokenFirst == $).
- self scanPast: #rightParenthesis level: bracketDepth.
- ^bracketDepth := bracketDepth - 1].
- currentTokenFirst == $[ ifTrue: [^self parseBlock].
- currentTokenFirst == ${
- ifTrue: [
- self scanPast: #leftBrace.
- ^self parseBraceArray].
- self isName ifTrue: [^self scanPast: (self resolve: currentToken)].
  self parseLiteral: false!

Item was changed:
  ----- Method: SHParserST80>>parseUnary (in category 'parse') -----
  parseUnary
+
+ [ self currentTokenType == #name ] whileTrue: [
+ self scanPast: (
+ (Symbol lookup: currentToken)
+ ifNotNil: [ #unary ]
+ ifNil:[
+ (Symbol thatStartsCaseSensitive: currentToken skipping: nil)
+ ifNil: [ #undefinedUnary ]
+ ifNotNil:[ #incompleteUnary ] ]) ]!
- | unary type |
-
-     [self isName]
-         whileTrue: [
- unary := currentToken.
- type := #unary.
- (unary isEmpty or:[(Symbol lookup: unary) notNil])
- ifFalse:[
- type := (Symbol thatStartsCaseSensitive: unary skipping: nil)
- ifNil: [#undefinedUnary]
- ifNotNil:[#incompleteUnary]].
- self scanPast: type]
- !

Item was added:
+ ----- Method: SHParserST80>>parseVerticalBarForTemporaries: (in category 'parse') -----
+ parseVerticalBarForTemporaries: barRangeType
+
+ currentTokenFirst == $| ifFalse: [ ^false ].
+ currentToken size = 1
+ ifTrue: [ self scanPast: barRangeType ]
+ ifFalse: [
+ "Apply a bit of surgery to separate the vertical bar from the rest of the token"
+ self
+ addRangeType: barRangeType
+ start: currentTokenSourcePosition
+ end: currentTokenSourcePosition.
+ currentToken := currentToken allButFirst.
+ currentTokenFirst := currentToken at: 1.
+ currentTokenType := nil.
+ currentTokenSourcePosition := currentTokenSourcePosition + 1 ].
+ ^true!

Item was removed:
- ----- Method: SHParserST80>>pushArgument: (in category 'parse support') -----
- pushArgument: aString
- (arguments at: blockDepth ifAbsentPut: [OrderedCollection new: 10])
- add: aString!

Item was removed:
- ----- Method: SHParserST80>>pushTemporary: (in category 'parse support') -----
- pushTemporary: aString
-
- (temporaries at: blockDepth ifAbsentPut: [ OrderedCollection new ])
- add: aString!

Item was removed:
- ----- Method: SHParserST80>>rangeType: (in category 'recording ranges') -----
- rangeType: aSymbol
- ^self
- rangeType: aSymbol
- start: currentTokenSourcePosition
- end: currentTokenSourcePosition + currentToken size - 1!

Item was removed:
- ----- Method: SHParserST80>>rangeType:start:end: (in category 'recording ranges') -----
- rangeType: aSymbol start: s end: e
- ^ranges add: (SHRange start: s end: e type: aSymbol)!

Item was added:
+ ----- Method: SHParserST80>>reservedKeywordNames (in category 'accessing') -----
+ reservedKeywordNames
+
+ ^#(#self #true #false #nil #super #thisContext)!

Item was removed:
- ----- Method: SHParserST80>>resolve: (in category 'identifier testing') -----
- resolve: aString
-
- aString = #self ifTrue: [ ^#self ].
- aString = #true ifTrue: [ ^#true ].
- aString = #false ifTrue: [ ^#false ].
- aString = #nil ifTrue: [ ^#nil ].
- aString = #super ifTrue: [ ^#super ].
- aString = #thisContext ifTrue: [ ^#thisContext ].
- (self isBlockTempName: aString) ifTrue: [^#blockTempVar].
- (self isBlockArgName: aString) ifTrue: [^#blockArg].
- (self isMethodTempName: aString) ifTrue: [^#tempVar].
- (self isMethodArgName: aString) ifTrue: [^#methodArg].
- (instanceVariables includes: aString) ifTrue: [^#instVar].
- workspace
- ifNotNil: [(workspace hasBindingOf: aString) ifTrue: [^#workspaceVar]].
- (Symbol lookup: aString) ifNotNil: [:sym |
- classOrMetaClass
- ifNotNil: [
- classOrMetaClass theNonMetaClass withAllSuperclassesDo: [:c |
- (c classPool bindingOf: sym) ifNotNil: [^#classVar].
- c sharedPools do: [:p | (p bindingOf: sym) ifNotNil: [^#poolConstant]].
- (c environment bindingOf: sym) ifNotNil: [^#globalVar]]]
- ifNil: [(environment bindingOf: sym) ifNotNil: [^#globalVar]]].
- ^self resolvePartial: aString!

Item was removed:
- ----- Method: SHParserST80>>resolvePartial: (in category 'identifier testing') -----
- resolvePartial: aString
- "check if any identifier begins with aString"
-
- (#('self' 'super' 'true' 'false' 'nil' 'thisContext') anySatisfy: [:each | each beginsWith: aString])
- ifTrue: [^#incompleteIdentifier].
- (self isIncompleteBlockTempName: aString) ifTrue: [^#incompleteIdentifier].
- (self isIncompleteBlockArgName: aString) ifTrue: [^#incompleteIdentifier].
- (self isIncompleteMethodTempName: aString) ifTrue: [^#incompleteIdentifier].
- (self isIncompleteMethodArgName: aString) ifTrue: [^#incompleteIdentifier].
- (instanceVariables anySatisfy: [:each | each beginsWith: aString]) ifTrue: [^#incompleteIdentifier].
- workspace
- ifNotNil: [(workspace hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
- classOrMetaClass
- ifNotNil: [
- classOrMetaClass theNonMetaClass withAllSuperclassesDo: [:c |
- (c classPool hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier].
- c sharedPools do: [:p | (p hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
- (c environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]]
- ifNil: [(environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]].
- ^#undefinedIdentifier!

Item was changed:
  ----- Method: SHParserST80>>scanComment (in category 'scan') -----
  scanComment
 
  | start |
  start := sourcePosition.
  (sourcePosition := source indexOf: $" startingAt: start + 1) = 0 ifTrue: [
  sourcePosition := source size + 1.
+ ^self
+ addRangeType: #unfinishedComment start: start end: source size;
+ fail ].
+ self
+ addRangeType: #comment start: start end: sourcePosition;
- self rangeType: #unfinishedComment start: start end: source size.
- ^self error ].
- start < sourcePosition ifTrue: [
- self rangeType: #comment start: start end: sourcePosition ].
- self
  nextChar;
  scanWhitespace!

Item was changed:
  ----- Method: SHParserST80>>scanIdentifier (in category 'scan') -----
  scanIdentifier
 
+ | c |
+ currentTokenSourcePosition := sourcePosition.
- | c start |
- start := sourcePosition.
  [
  (c := self nextChar) isAlphaNumeric
+ or: [ c == $_ and: [ allowUnderscoreSelectors ] ] ] whileTrue.
+ (c == $: and: [ self peekChar ~~ $= ])
- or: [ allowUnderscoreSelectors and: [ c == $_ ] ] ] whileTrue.
- (c == $: and: [ self peekChar ~= $= ])
  ifTrue: [ self nextChar ].
+ currentToken := source copyFrom: currentTokenSourcePosition to: sourcePosition - 1!
- currentToken := source copyFrom: start to: sourcePosition - 1.
- currentTokenSourcePosition := start!

Item was changed:
  ----- Method: SHParserST80>>scanNext (in category 'scan') -----
  scanNext
 
  self scanWhitespace.
+ currentTokenType := nil.
  currentTokenFirst := self currentChar ifNil: [
  " end of input "
  currentTokenFirst := $ .
  currentTokenSourcePosition := nil.
  currentToken := nil.
  ^nil ].
  currentTokenFirst isDigit ifTrue: [ ^self scanNumber ].
  (currentTokenFirst isLetter or: [
+ currentTokenFirst == $_ and: [ allowUnderscoreSelectors ] ])
- allowUnderscoreSelectors and: [ currentTokenFirst == $_ ] ])
  ifTrue: [ ^self scanIdentifier ].
  ^self scanBinary!

Item was changed:
  ----- Method: SHParserST80>>scanNumber (in category 'scan') -----
  scanNumber
+
+ | c |
+ currentTokenSourcePosition := sourcePosition.
- | start c nc base |
- start := sourcePosition.
  self skipDigits.
+ (c := self currentChar) == $r
- c := self currentChar.
- c == $r
  ifTrue: [
+ | base |
+ base := (source copyFrom: currentTokenSourcePosition to: sourcePosition - 1) asUnsignedInteger.
+ base < 2 ifTrue: [ self fail ": radix must be greater than 1" ].
+ self peekChar == $- ifTrue: [ self nextChar ].
+ self skipDigitsBase: base.
+ (c := self currentChar) == $. ifTrue: [
+ (self isDigit: self peekChar base: base) ifTrue: [
+ self skipDigitsBase: base].
+ c := self currentChar ] ]
+ ifFalse: [
+ c == $. ifTrue: [
+ self peekChar isDigit ifFalse: [
+ ^currentToken := source copyFrom: currentTokenSourcePosition to: sourcePosition - 1 ].
+ self skipDigits.
+ c := self currentChar ] ].
- base := Integer readFrom: (ReadStream on: (source copyFrom: start to: sourcePosition - 1)).
- self peekChar == $- ifTrue:[self nextChar].
- self skipBigDigits: base.
- c := self currentChar.
- c == $.
- ifTrue: [
- (self isBigDigit: self nextChar base: base)
- ifFalse: [sourcePosition := sourcePosition - 1]
- ifTrue: [self skipBigDigits: base]].
- c := self currentChar.
- ('deq'includes: c)
- ifTrue: [
- ((nc := self nextChar) isDigit or: [nc == $- and: [ self peekChar isDigit ]])
- ifFalse: [sourcePosition := sourcePosition - 1]
- ifTrue: [self skipDigits]].
- c == $s ifTrue: [
- (nc := self nextChar) isDigit
- ifTrue: [ self skipDigits ]
- ifFalse: [
- nc isLetter ifTrue: [
- sourcePosition := sourcePosition - 1 ] ] ].
- currentToken := source copyFrom: start to: sourcePosition - 1.
- ^currentTokenSourcePosition := start].
  c == $s
  ifTrue: [
+ (c := self nextChar) isDigit
+ ifFalse: [ c isLetter ifTrue: [sourcePosition := sourcePosition - 1 ] ]
+ ifTrue: [ self skipDigits ] ]
+ ifFalse: [
+ (c == $d
+ or: [ c == $e
+ or: [ c == $q ] ])
+ ifTrue: [
+ ((c := self nextChar) isDigit or: [ c == $-  and: [ self peekChar isDigit ] ])
+ ifFalse: [ sourcePosition := sourcePosition - 1 ]
+ ifTrue: [ self skipDigits ] ] ].
+ currentToken := source copyFrom: currentTokenSourcePosition to: sourcePosition - 1!
- (nc := self nextChar) isDigit
- ifFalse: [nc isLetter ifTrue: [sourcePosition := sourcePosition - 1]]
- ifTrue: [self skipDigits.].
- currentToken := source copyFrom: start to: sourcePosition - 1.
- ^currentTokenSourcePosition := start].
- c == $.
- ifTrue: [
- self nextChar isDigit
- ifFalse: [
- sourcePosition := sourcePosition - 1.
- currentToken := source copyFrom: start to: sourcePosition - 1.
- ^currentTokenSourcePosition := start]
- ifTrue: [self skipDigits]].
- c := self currentChar.
- ('deq' includes: c)
- ifTrue: [
- ((nc := self nextChar) isDigit or: [nc == $-  and:[ self peekChar isDigit ]])
- ifFalse: [sourcePosition := sourcePosition - 1]
- ifTrue: [self skipDigits]].
- c == $s
- ifTrue: [
- (nc := self nextChar) isDigit
- ifFalse: [nc isLetter ifTrue: [sourcePosition := sourcePosition - 1]]
- ifTrue: [self skipDigits]].
- currentToken := source copyFrom: start to: sourcePosition - 1.
- ^currentTokenSourcePosition := start!

Item was changed:
  ----- Method: SHParserST80>>scanPast: (in category 'scan') -----
  scanPast: rangeType
  "record rangeType for current token .
- record argument and temp declarations.
  scan and answer the next token"
+
- rangeType == #blockPatternArg ifTrue: [self pushArgument: currentToken].
- rangeType == #blockPatternTempVar ifTrue: [self pushTemporary: currentToken].
- rangeType == #patternArg ifTrue: [self pushArgument: currentToken].
- rangeType == #patternTempVar ifTrue: [self pushTemporary: currentToken].
  ^self
+ addRangeType: rangeType;
- rangeType: rangeType;
  scanNext!

Item was changed:
  ----- Method: SHParserST80>>scanPast:start:end: (in category 'scan') -----
  scanPast: rangeType start: startInteger end: endInteger
  "record rangeType for current token from startInteger to endInteger,
  and scanNext token"
 
  ^self
+ addRangeType: rangeType start: startInteger end: endInteger;
- rangeType: rangeType start: startInteger end: endInteger;
  scanNext
 
  !

Item was added:
+ ----- Method: SHParserST80>>scanPastBracket: (in category 'scan') -----
+ scanPastBracket: rangeType
+ "first level adds no suffix to the rangeType.
+ Suffix from 1 to 7 added in cycles , ((level-2) mod(7) + 1)"
+
+ | rangeTypeForDepth |
+ rangeTypeForDepth := bracketDepth = 1
+ ifTrue: [ rangeType ]
+ ifFalse: [
+ (rangeType
+ caseOf: {
+ [ #blockStart ] -> [ #(blockStart1 blockStart2 blockStart3 blockStart4 blockStart5 blockStart6 blockStart7) ].
+ [ #blockEnd ] -> [ #(blockEnd1 blockEnd2 blockEnd3 blockEnd4 blockEnd5 blockEnd6 blockEnd7) ].
+ [ #leftParenthesis ] -> [ #(leftParenthesis1 leftParenthesis2 leftParenthesis3 leftParenthesis4 leftParenthesis5 leftParenthesis6 leftParenthesis7) ].
+ [ #rightParenthesis ] -> [ #(rightParenthesis1 rightParenthesis2 rightParenthesis3 rightParenthesis4 rightParenthesis5 rightParenthesis6 rightParenthesis7) ] }
+ otherwise: [ self fail ": 'Unknown range type ', rangeType asString" ]) atWrap: bracketDepth - 1 ].
+ self scanPast: rangeTypeForDepth
+ !

Item was removed:
- ----- Method: SHParserST80>>skipBigDigits: (in category 'scan') -----
- skipBigDigits: baseInteger
- [self isBigDigit: self nextChar base: baseInteger]
- whileTrue: []
- !

Item was changed:
  ----- Method: SHParserST80>>skipDigits (in category 'scan') -----
  skipDigits
 
+ | c |
+ [
+ (c := self nextChar asInteger) < 48 ifTrue: [ ^self ].
+ c > 57 ifTrue: [ ^self ]  ] repeat!
- [ self nextChar isDigit ] whileTrue!

Item was added:
+ ----- Method: SHParserST80>>skipDigitsBase: (in category 'scan') -----
+ skipDigitsBase: baseInteger
+  
+ [ self isDigit: self nextChar base: baseInteger ] whileTrue
+ !

Item was changed:
  ----- Method: SHTextStylerST80>>replaceStringForRangesWithType:with:in: (in category 'private') -----
  replaceStringForRangesWithType: aSymbol with: aString in: aText
  "Answer aText if no replacements, or a copy of aText with
  each range with a type of aSymbol replaced by aString"
+
+ | answer rangesToReplace adjustSourceMap increaseInLength stringSize |
+ rangesToReplace := self rangesIn: aText setWorkspace: false.
+ rangesToReplace removeAllSuchThat: [ :range | range type ~~ aSymbol ].
+ rangesToReplace isEmpty ifTrue: [^aText].
- | answer toReplace adjustSourceMap increaseInLength |
-
- toReplace := self rangesIn: aText setWorkspace: false.
- toReplace removeAllSuchThat: [ :each | each type ~~ aSymbol ].
- toReplace isEmpty ifTrue: [^aText].
  answer := aText copy.
  increaseInLength := 0.
  adjustSourceMap := sourceMap notNil and:[sourceMap ~~ processedSourceMap].
+ (rangesToReplace isSortedBy: [ :a :b | a start <= b start ]) ifFalse: [
+ "Can this ever happen?"
+ rangesToReplace sort: [ :a :b | a start <= b start ] ].
+ stringSize := aString size.
+ rangesToReplace do: [ :range |
+ | end start thisIncrease |
+ start := range start + increaseInLength.
+ end := range end + increaseInLength.
+ answer replaceFrom: start to: end with: aString.
+ thisIncrease := stringSize - range length.
+ increaseInLength := increaseInLength + thisIncrease.
+ adjustSourceMap ifTrue: [
+ sourceMap do: [ :association |
+ | first newFirst last newLast |
+ first := newFirst := association value first.
+ last := newLast := association value last.
+ first > start ifTrue: [ newFirst := first + thisIncrease ].
+ last > start ifTrue: [ newLast := last + thisIncrease ].
+ (first ~= newFirst or: [ last ~= newLast ])
+ ifTrue:[ association value: (newFirst to: newLast) ] ] ] ].
- toReplace
- sort: [:a :b | a start <= b start];
- do: [:each | | end start thisIncrease |
- start := each start + increaseInLength.
- end := each end + increaseInLength.
- answer replaceFrom: start to: end with: aString.
- thisIncrease := aString size - each length.
- increaseInLength := increaseInLength + thisIncrease.
- adjustSourceMap ifTrue:[
- sourceMap do:[:assoc | | first newFirst last newLast |
- first := newFirst := assoc value first.
- last := newLast := assoc value last.
- first > start ifTrue:[newFirst := first + thisIncrease].
- last > start ifTrue:[newLast := last + thisIncrease].
- (first ~= newFirst or:[last ~= newLast])
- ifTrue:[assoc value: (newFirst to: newLast)]]]].
  adjustSourceMap ifTrue:[processedSourceMap := sourceMap].
  ^answer!

Item was changed:
+ (PackageInfo named: 'ShoutCore') postscript: 'SHTextStylerST80 allInstancesDo: [ :each | each instVarNamed: #parser put: nil ]'!
- (PackageInfo named: 'ShoutCore') postscript: 'SHTextStylerST80 syntaxHighlightingAsYouType: Preferences syntaxHighlightingAsYouType.
- SHTextStylerST80 syntaxHighlightingAsYouTypeLeftArrowAssignment: Preferences syntaxHighlightingAsYouTypeLeftArrowAssignment.
- SHTextStylerST80 syntaxHighlightingAsYouTypeAnsiAssignment: Preferences syntaxHighlightingAsYouTypeAnsiAssignment.'!