"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
Object subclass:#Scanner
instanceVariableNames:'typeArray actionArray source lineNr token tokenType tokenPosition
tokenValue tokenName tokenLineNr hereChar peekChar peekChar2
requestor exitBlock errorFlag ignoreErrors ignoreWarnings
saveComments currentComments collectedSource
allowUnderscoreInIdentifier allowDollarInIdentifier
warnSTXSpecialComment warnUnderscoreInIdentifier
warnOldStyleAssignment warnCommonMistakes outStream outCol
warnSTXNameSpaceUse warnPossibleIncompatibilities
warnDollarInIdentifier'
classVariableNames:'TypeArray ActionArray AllowUnderscoreInIdentifier Warnings
WarnSTXSpecials WarnOldStyleAssignment WarnUnderscoreInIdentifier
WarnCommonMistakes WarnPossibleIncompatibilities
WarnDollarInIdentifier AllowDollarInIdentifier
EmptySourceNotificationSignal'
poolDictionaries:''
category:'System-Compiler'
!
Object subclass:#Comment
instanceVariableNames:'commentType commentString'
classVariableNames:''
poolDictionaries:''
privateIn:Scanner
!
!Scanner class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
Scanner reads from a stream and returns individual smalltalk tokens
Its main method is #nextToken, which reads and returns the next token
Possibly placing additional information (such as tokenValue) into
instance variables as a side effect.
TODO:
some testers noticed, that ST-80's scanner methods are called
xLetter, xDigit etc. For code using these (internals), the nextNumber,
nextIdentifier etc. methods should be renamed.
(to me, these seem to be internal private methods;
their public use is not a good idea ..)
Scanner is typically subclassed for parsing and #nextToken
invoked via #self-sends.
This should be changed and scanner ought to be an instance variable
of Parser - this allows more flexible use of the scanner/parser
framework (i.e. changing the scanner without affecting the parser).
[author:]
Claus Gittinger
[see also:]
Parser
"
! !
!Scanner class methodsFor:'initialization'!
binarySelectorCharacters
"return a collection of characters which are allowed in
binary selectors"
^ #( $& $- $+ $= $* $/ $\ $< $> $~ $@ $, $? $!! $| $%)
"Created: / 4.1.1997 / 14:13:24 / cg"
"Modified: / 27.2.1998 / 02:01:28 / cg"
!
setupActions
"initialize the scanners actionTables - these are used to dispatch
into scanner methods as characters are read"
|block|
ActionArray := Array new:256.
TypeArray := Array new:256.
block := [:s :char | s nextNumber].
($0 asciiValue) to:($9 asciiValue) do:[:index |
ActionArray at:index put:block
].
block := [:s :char | s nextSpecial].
self binarySelectorCharacters do:[:binop |
TypeArray at:(binop asciiValue) put:#special.
ActionArray at:(binop asciiValue) put:block
].
"/ that one is a special case (both binarySelector AND syntax).
TypeArray at:($| asciiValue) put:nil.
block := [:s :char | s nextToken:char].
#( $; $. $( $) $[ $] "$!!" $^ $| $_ ) do:[:ch |
ActionArray at:(ch asciiValue) put:block
].
block := [:s :char | s nextIdentifier].
($a asciiValue) to:($z asciiValue) do:[:index |
ActionArray at:index put:block
].
($A asciiValue) to:($Z asciiValue) do:[:index |
ActionArray at:index put:block
].
AllowUnderscoreInIdentifier ifTrue:[
ActionArray at:$_ asciiValue put:block
].
"kludge: action is characterToken, but type is special"
TypeArray at:($| asciiValue) put:#special.
"kludge: action is nextColonOrAssign, but type is special"
TypeArray at:($: asciiValue) put:#special.
ActionArray at:($' asciiValue) put:[:s :char | s nextString].
ActionArray at:($$ asciiValue) put:[:s :char | s nextCharacter].
ActionArray at:($# asciiValue) put:[:s :char | s nextHash].
ActionArray at:($% asciiValue) put:[:s :char | s nextPrimitive].
ActionArray at:($: asciiValue) put:[:s :char | s nextColonOrAssign]
"
Scanner setupActions
"
"Modified: 23.5.1997 / 12:07:55 / cg"
! !
!Scanner class methodsFor:'instance creation'!
for:aStringOrStream
"create & return a new scanner reading from aStringOrStream"
^ (super new) initializeFor:aStringOrStream
"Modified: 23.5.1997 / 12:08:42 / cg"
! !
!Scanner class methodsFor:'Signal constants'!
emptySourceNotificationSignal
^ EmptySourceNotificationSignal
"Created: / 16.5.1998 / 15:55:14 / cg"
! !
!Scanner class methodsFor:'class initialization'!
initialize
"initialize the classes defaults. Typically, these are changed
later in the 'private.rc' file."
EmptySourceNotificationSignal isNil ifTrue:[
EmptySourceNotificationSignal := QuerySignal new mayProceed:true.
EmptySourceNotificationSignal notifierString:'empty source given to evaluate'.
EmptySourceNotificationSignal nameClass:self message:#emptySourceNotificationSignal.
].
Warnings := true.
WarnSTXSpecials := true.
WarnUnderscoreInIdentifier := true.
WarnDollarInIdentifier := true.
WarnOldStyleAssignment := true.
WarnCommonMistakes := true.
WarnPossibleIncompatibilities := false.
AllowUnderscoreInIdentifier := false.
AllowDollarInIdentifier := false.
"
self initialize
"
"Modified: / 16.5.1998 / 15:55:41 / cg"
! !
!Scanner class methodsFor:'defaults'!
allowDollarInIdentifier
"return true, if $-characters are allowed in identifiers.
Notice, that dollars are NEVER allowed as the first character in an identifier."
^ AllowDollarInIdentifier
"Created: 7.9.1997 / 01:32:18 / cg"
"Modified: 7.9.1997 / 01:39:44 / cg"
!
allowDollarInIdentifier:aBoolean
"this allows turning on/off $-characters in identifiers.
Notice, that dollars are NEVER allowed as the first character in an identifier.
If turned off (the default), dollars are not allowed in identifiers,
but instead are scanned as character-constant prefix.
If turned on, dollars are in identifiers are allowed, while extra
dollars are still scanned as constant character prefix.
If you have to fileIn old VW-Vsn2.x classes, turn this off
before filing them in; i.e.:
Compiler allowDollarInIdentifiers:false"
AllowDollarInIdentifier := aBoolean.
self setupActions
"Created: 7.9.1997 / 01:34:49 / cg"
"Modified: 7.9.1997 / 01:39:30 / cg"
!
allowUnderscoreInIdentifier
"return true, if underscores are allowed in identifiers"
^ AllowUnderscoreInIdentifier
!
allowUnderscoreInIdentifier:aBoolean
"this allows turning on/off underscores in identifiers.
If turned off (the default), underscores are not allowed in identifiers,
but instead scanned as assignment character (old ST/80 syntax).
If turned on, underscores are in identifiers are allowed, while extra
underscores are still scanned as assignment.
If you have to fileIn old VW-Vsn2.x classes,
turn them off with:
Compiler allowUnderscoreInIdentifiers:false"
AllowUnderscoreInIdentifier := aBoolean.
self setupActions
"Modified: 7.9.1997 / 01:35:19 / cg"
!
warnCommonMistakes
"return true, if common beginners mistakes are to be warned about"
^ WarnCommonMistakes
!
warnCommonMistakes:aBoolean
"this allows turning on/off warnings about common beginners mistakes.
Those are not really errors in the strict sense, but often lead to
run time errors later.
Examples are: expr or:expr2, where expr2 is not a block.
If you get bored by those warnings, turn them off by adding
a line as:
Compiler warnCommonMistakes:false
in your 'private.rc' file"
WarnCommonMistakes := aBoolean
!
warnDollarInIdentifier
"return true, if $-characters in identifiers are to be warned about"
^ WarnDollarInIdentifier
"Created: 7.9.1997 / 01:36:17 / cg"
!
warnDollarInIdentifier:aBoolean
"this allows turning on/off warnings about $-characters in identifiers.
You may find those warnings useful, to make certain that your code
is portable to other smalltalk versions, which do not allow this
(i.e. VW releases 2.x and maybe others).
Notice, that dollars are NEVER allowed as the first character in an identifier.
If you get bored by those warnings, turn them off by adding
a line as:
Compiler warnDollarInIdentifier:false
in your 'private.rc' file"
WarnDollarInIdentifier := aBoolean
"Created: 7.9.1997 / 01:37:42 / cg"
"Modified: 7.9.1997 / 01:40:02 / cg"
!
warnOldStyleAssignment
"return true, if underscore-assignment (pre ST-80v4 syntax) are to be warned about"
^ WarnOldStyleAssignment
!
warnOldStyleAssignment:aBoolean
"this allows turning on/off warnings about underscore-assignment (pre ST-80v4 syntax).
If you get bored by those warnings, turn them off by adding
a line as:
Compiler warnOldStyleAssignment:false
in your 'private.rc' file"
WarnOldStyleAssignment := aBoolean
!
warnPossibleIncompatibilities
"return true, if possible incompatibilities (with other ST systems)
are to be warned about"
^ WarnPossibleIncompatibilities
"Modified: 23.5.1997 / 12:02:02 / cg"
!
warnPossibleIncompatibilities:aBoolean
"this turns warnings about possible incompatibilities (with other ST systems)
on or off.
If you get bored by those warnings, turn them off by adding
a line as:
Compiler warnPossibleIncompatibilities:false
in your 'private.rc' file."
WarnPossibleIncompatibilities := aBoolean
"Created: 23.5.1997 / 12:02:45 / cg"
!
warnSTXSpecials
"return true, if ST/X specials are to be warned about"
^ WarnSTXSpecials
!
warnSTXSpecials:aBoolean
"this allows turning on/off warnings about stx specials.
If you get bored by those warnings, turn them off by adding
a line as:
Compiler warnSTXSpecials:false
in your 'private.rc' file"
WarnSTXSpecials := aBoolean
!
warnUnderscoreInIdentifier
"return true, if underscores in identifiers are to be warned about"
^ WarnUnderscoreInIdentifier
!
warnUnderscoreInIdentifier:aBoolean
"this allows turning on/off warnings about underscores in identifiers.
You may find those warnings useful, to make certain that your code
is portable to other smalltalk versions, which do not allow this
(i.e. VW releases 2.x).
If you get bored by those warnings, turn them off by adding
a line as:
Compiler warnUnderscoreInIdentifier:false
in your 'private.rc' file"
WarnUnderscoreInIdentifier := aBoolean
"Modified: 7.9.1997 / 01:37:13 / cg"
!
warnings
"return true, if any warnings are to be shown"
^ Warnings
!
warnings:aBoolean
"this allows turning on/off all warnings; the default is on.
You can turn off warnings in your 'private.rc' file with
Compiler warnings:false
"
Warnings := aBoolean
"Modified: 23.5.1997 / 12:03:05 / cg"
! !
!Scanner methodsFor:'ST-80 compatibility'!
endOfLastToken
"return the position of the token which was just read.
This method was required by some PD program.
It is not maintained and may be removed without notice."
^ source position
"Modified: 23.5.1997 / 12:14:27 / cg"
!
scan:aStringOrStream
"initialize the scanner: set the source-stream and
preread the first token"
self initializeFor:aStringOrStream.
self nextToken
"Created: / 30.10.1997 / 16:59:39 / cg"
!
scanToken
"read the next token from my input stream"
^ self nextToken
"Created: / 30.10.1997 / 17:00:16 / cg"
!
scanTokens:aStringOrStream
"return a collection of symbolic tokens from the passed input"
|tokens|
self initializeFor:aStringOrStream.
tokens := OrderedCollection new.
self nextToken.
[token notNil] whileTrue:[
tokens add:token.
self nextToken
].
^ tokens
"
Scanner new
scanTokens:'Boolean subclass:#True
instanceVariableNames:''''
classVariableNames:''''
poolDictionaries:''''
category:''Kernel-Objects''
'
"
"Modified: 20.6.1997 / 18:22:58 / cg"
! !
!Scanner methodsFor:'accessing'!
comments
"not yet implemented"
^ currentComments
"Created: 20.4.1996 / 20:07:01 / cg"
"Modified: 23.5.1997 / 12:14:45 / cg"
!
saveComments:aBoolean
"not yet implemented"
saveComments := aBoolean
"Created: 20.4.1996 / 20:03:56 / cg"
"Modified: 23.5.1997 / 12:14:49 / cg"
!
sourceStream
^ source
"Created: 20.4.1996 / 19:59:58 / cg"
! !
!Scanner methodsFor:'directives'!
parseDirective
"parse a directive - this is an ST/X special"
|directive packageName namespace list|
source next.
source skipSeparatorsExceptCR.
hereChar := source peekOrNil.
hereChar isLetter ifTrue:[
directive := source nextWord.
source peekOrNil == $: ifTrue:[
source next.
source skipSeparatorsExceptCR.
hereChar := source peekOrNil.
"
Package: 'name-of-package'
Package: packageId
"
directive = 'Package' ifTrue:[
packageName := self parseDirectiveStringArg.
packageName notNil ifTrue:[
(requestor respondsTo:#setPackage:) ifTrue:[
requestor setPackage:packageName
].
] ifFalse:[
Transcript showCR:'unrecognized ''Package'' directive'.
^ false
]
].
"
Namespace: 'nameSpaceIdentifier'
Namespace: nameSpaceIdentifier
"
(directive = 'Namespace'
or:[directive = 'NameSpace']) ifTrue:[
namespace := self parseDirectiveStringArg.
namespace notNil ifTrue:[
(requestor respondsTo:#setNameSpace:) ifTrue:[
requestor setNameSpace:namespace
] ifFalse:[
self setNameSpace:namespace
].
] ifFalse:[
Transcript showCR:'unrecognized ''NameSpace'' directive'.
^ false
].
].
"
Uses: 'nameSpace1', ... , 'nameSpaceN'
Uses: nameSpaceId1, ... , nameSpaceIdN
"
directive = 'Uses' ifTrue:[
list := self parseDirectiveStringListArg.
list notNil ifTrue:[
(requestor respondsTo:#addNameSpaces:) ifTrue:[
requestor addNameSpaces:list
]
] ifFalse:[
Transcript showCR:'unrecognized ''Uses'' directive'.
^ false
]
].
"
Prerequisites: 'name-of-package', ... , 'name-of-package'
"
directive = 'Prerequisites' ifTrue:[
list := self parseDirectiveStringListArg.
list notNil ifTrue:[
(requestor respondsTo:#requirePackages:) ifTrue:[
requestor requirePackages:list
].
] ifFalse:[
Transcript showCR:'unrecognized ''Prerequisites'' directive'.
^ false
]
].
]
].
hereChar := source peekOrNil.
^ true.
"Modified: / 5.3.1998 / 02:55:32 / cg"
!
parseDirectiveStringArg
"helper for parsing a directive"
hereChar == $' ifTrue:[
self nextString.
tokenType == #String ifTrue:[
^ tokenValue
]
].
(hereChar isLetter or:[hereChar == $_]) ifTrue:[
self nextIdentifier.
tokenType == #Identifier ifTrue:[
^ tokenName
]
].
^ nil
"Modified: 23.5.1997 / 12:15:46 / cg"
!
parseDirectiveStringListArg
"helper for parsing a directive"
|list|
list := OrderedCollection new.
[hereChar == $'] whileTrue:[
list addLast:self parseDirectiveStringArg.
source skipSeparatorsExceptCR.
hereChar := source peekOrNil.
(hereChar == $,) ifTrue:[
source next.
source skipSeparatorsExceptCR.
hereChar := source peekOrNil.
].
].
^ list
"Modified: / 5.3.1998 / 02:55:40 / cg"
! !
!Scanner methodsFor:'dummy - syntax highlighting'!
markCommentFrom:pos1 to:pos2
"Created: / 31.3.1998 / 13:34:45 / cg"
!
markConstantFrom:pos1 to:pos2
"Created: / 1.4.1998 / 13:02:56 / cg"
!
markStringFrom:pos1 to:pos2
"Created: / 31.3.1998 / 16:37:18 / cg"
!
markSymbolFrom:pos1 to:pos2
"Created: / 1.4.1998 / 12:58:42 / cg"
! !
!Scanner methodsFor:'error handling'!
correctableError:message position:pos1 to:pos2
"report an error which can be corrected by compiler -
return true if correction is wanted"
|correctIt|
requestor isNil ifTrue:[
self showErrorMessage:message position:pos1.
correctIt := false
] ifFalse:[
correctIt := requestor correctableError:message position:pos1 to:pos2 from:self
].
correctIt ifFalse:[
exitBlock notNil ifTrue:[exitBlock value]
].
^ correctIt
"Created: / 13.5.1998 / 16:45:56 / cg"
!
lastTokenLineNumber
"return the line number of the token which was just read."
^ tokenLineNr
"Created: 8.11.1996 / 18:46:36 / cg"
"Modified: 23.5.1997 / 12:16:12 / cg"
!
notifyError:aMessage position:position to:endPos
"notify requestor of an error - if there is no requestor
put it on the transcript. Requestor is typically the CodeView
in which the accept/doIt was triggered, or the PositionableStream
which does the fileIn. The requestor may decide how to highlight the
error (and/or to abort the compile).
Return the result passed back by the requestor."
ignoreErrors ifFalse:[
requestor isNil ifTrue:[
self showErrorMessage:aMessage position:position.
^ false
].
^ requestor error:aMessage position:position to:endPos from:self
].
^ false
!
notifyWarning:aMessage position:position to:endPos
"notify requestor of an warning - if there is no requestor
put it on the transcript.
Return the result passed back by the requestor."
ignoreWarnings ifFalse:[
requestor isNil ifTrue:[
self showErrorMessage:aMessage position:position.
^ false
].
^ requestor warning:aMessage position:position to:endPos from:self
].
^ false
!
parseError:aMessage
"report an error"
^ self parseError:aMessage position:tokenPosition to:nil
"Created: / 13.5.1998 / 16:45:13 / cg"
!
parseError:aMessage position:position
"report an error"
^ self parseError:aMessage position:position to:nil
"Created: / 13.5.1998 / 16:45:05 / cg"
!
parseError:aMessage position:position to:endPos
"report an error"
|m|
errorFlag := true.
m := 'Error: ' , aMessage.
self notifyError:m position:position to:endPos.
exitBlock notNil ifTrue:[exitBlock value].
^ false
"Created: / 13.5.1998 / 16:44:55 / cg"
!
showErrorMessage:aMessage position:pos
"show an errormessage on the Transcript"
ignoreErrors ifFalse:[
Smalltalk silentLoading == true ifFalse:[
Transcript showCR:(pos printString , ' [line: ' , tokenLineNr printString , '] ' , aMessage)
]
]
"Modified: 18.5.1996 / 15:44:35 / cg"
!
syntaxError:aMessage
"a syntax error happened - position is not known"
^ self syntaxError:aMessage position:tokenPosition
!
syntaxError:aMessage position:position
"a syntax error happened - only start position is known"
^ self syntaxError:aMessage position:position to:nil
!
syntaxError:aMessage position:position to:endPos
"a syntax error happened"
self notifyError:('Error:' , aMessage) position:position to:endPos.
exitBlock notNil ifTrue:[exitBlock value].
^ false
!
warnCommonMistake:msg at:position
"warn about a common beginners mistake"
self warnCommonMistake:msg position:position to:position
"Modified: 23.5.1997 / 12:16:34 / cg"
!
warnCommonMistake:msg position:pos1 to:pos2
"warn about a common beginners mistake"
ignoreWarnings ifFalse:[
warnCommonMistakes ifTrue:[
self
warning:msg
position:pos1 to:pos2.
]
]
"Created: 18.7.1996 / 10:28:38 / cg"
"Modified: 23.5.1997 / 12:16:39 / cg"
!
warnDollarAt:position
"warn about $-character in an identifier"
ignoreWarnings ifFalse:[
warnDollarInIdentifier ifTrue:[
self
warning:'$-characters in identifiers/symbols are nonportable'
position:position to:position.
"
only warn once (per method)
"
warnDollarInIdentifier := false
]
]
"Created: 7.9.1997 / 01:50:24 / cg"
"Modified: 7.9.1997 / 01:51:13 / cg"
!
warnOldStyleAssignmentAt:position
"warn about an oldStyle assignment"
ignoreWarnings ifFalse:[
warnOldStyleAssignment ifTrue:[
self
warning:'old style assignment - please change to use '':='''
position:position to:position.
"
only warn once (per method)
"
warnOldStyleAssignment := false
]
]
"Modified: 23.5.1997 / 12:16:48 / cg"
!
warnPossibleIncompatibility:msg position:pos1 to:pos2
"warn about a possible incompatibility with other ST systems"
ignoreWarnings ifFalse:[
warnPossibleIncompatibilities ifTrue:[
self
warning:('Possible incompatibility.\\' , msg) withCRs
position:pos1 to:pos2.
]
]
"Created: 23.5.1997 / 12:17:54 / cg"
"Modified: 23.5.1997 / 12:22:37 / cg"
!
warnUnderscoreAt:position
"warn about an underscore in an identifier"
ignoreWarnings ifFalse:[
warnUnderscoreInIdentifier ifTrue:[
self
warning:'underscores in identifiers/symbols are nonportable'
position:position to:position.
"
only warn once (per method)
"
warnUnderscoreInIdentifier := false
]
]
"Modified: 23.5.1997 / 12:17:06 / cg"
!
warning:aMessage
"a warning - position is not known"
^ self warning:aMessage position:tokenPosition
!
warning:aMessage position:position
"a warning - only start position is known"
^ self warning:aMessage position:position to:nil
!
warning:aMessage position:position to:endPos
"a warning"
^ self notifyWarning:('Warning: ' , aMessage) position:position to:endPos
! !
!Scanner methodsFor:'general scanning'!
scanPositionsFor:aTokenString inString:aSourceString
"scan aSourceString for occurrances of aTokenString.
Return a collection of start positions.
Added for VW compatibility (to support syntax-highlight)."
|searchType searchName searchValue positions t|
"
first, look what kind of token we have to search for
"
self initializeFor:(ReadStream on:aTokenString).
self nextToken.
searchType := tokenType.
searchName := tokenName.
searchValue := tokenValue.
"
start the real work ...
"
self initializeFor:(ReadStream on:aSourceString).
positions := OrderedCollection new.
[(t := self nextToken) ~~ #EOF] whileTrue:[
searchType == t ifTrue:[
(searchName isNil or:[tokenName = searchName]) ifTrue:[
(searchValue isNil or:[tokenValue = searchValue]) ifTrue:[
positions add:tokenPosition.
]
]
]
].
^ positions
"
Scanner new scanPositionsFor:'hello' inString:'foo bar hello baz hello'
Scanner new scanPositionsFor:'3.14' inString:'foo 3.145 bar hello 3.14 baz hello 3.14'
Scanner new scanPositionsFor:'16' inString:'foo 16 bar hello 16r10 baz hello 2r10000'
"
! !
!Scanner methodsFor:'initialization'!
initialize
"initialize the scanner"
errorFlag := false.
tokenPosition := 1.
tokenLineNr := lineNr := 1.
currentComments := nil.
saveComments := false.
ignoreErrors := false.
ignoreWarnings := Warnings not.
warnSTXSpecialComment := WarnSTXSpecials.
warnSTXNameSpaceUse := WarnSTXSpecials.
warnUnderscoreInIdentifier := WarnUnderscoreInIdentifier.
warnDollarInIdentifier := WarnDollarInIdentifier.
warnOldStyleAssignment := WarnOldStyleAssignment.
warnCommonMistakes := WarnCommonMistakes.
warnPossibleIncompatibilities := WarnPossibleIncompatibilities.
allowUnderscoreInIdentifier := AllowUnderscoreInIdentifier.
allowDollarInIdentifier := AllowDollarInIdentifier.
ActionArray isNil ifTrue:[
self class setupActions
].
actionArray := ActionArray.
typeArray := TypeArray.
"Modified: 7.9.1997 / 01:51:01 / cg"
!
initializeFor:aStringOrStream
"initialize the new scanner & prepare for reading from aStringOrStream"
self initialize.
aStringOrStream isStream ifFalse:[
source := ReadStream on:aStringOrStream
] ifTrue:[
source := aStringOrStream.
].
"Modified: 23.5.1997 / 12:00:39 / cg"
! !
!Scanner methodsFor:'private'!
backupPosition
"if reading from a stream, at the end we might have read
one token too many"
(tokenType == #EOF) ifFalse:[
source position:tokenPosition
]
!
beginComment
^ self
!
checkForKeyword:string
"check if string is a keyword (as opposed to an identifier).
That is, its one of 'self', 'super', 'nil', 'true', 'false',
or 'thisContext'.
'here' is handled elsewhere (since it must be treated as an
identifier, if declared locally."
|firstChar|
firstChar := string at:1.
(firstChar == $s) ifTrue:[
(string = 'self') ifTrue:[tokenType := #Self. ^true].
(string = 'super') ifTrue:[tokenType := #Super. ^true]
].
(firstChar == $n) ifTrue:[
(string = 'nil') ifTrue:[tokenType := #Nil. ^true]
].
(firstChar == $t) ifTrue:[
(string = 'true') ifTrue:[tokenType := #True. ^true].
(string = 'thisContext') ifTrue:[tokenType := #ThisContext. ^true]
].
(firstChar == $f) ifTrue:[
(string = 'false') ifTrue:[tokenType := #False. ^true]
].
^ false
"Modified: / 13.5.1998 / 14:59:55 / cg"
!
collectedSource
^ collectedSource
!
endComment:comment
saveComments ifTrue:[
currentComments isNil ifTrue:[
currentComments := OrderedCollection with:comment
] ifFalse:[
currentComments add:comment
]
].
!
endComment:commentString type:commentType
|comment|
saveComments ifTrue:[
comment := Comment new.
comment commentString:commentString; commentType:commentType.
currentComments isNil ifTrue:[
currentComments := OrderedCollection with:comment
] ifFalse:[
currentComments add:comment
]
].
"Created: / 17.2.1998 / 14:48:49 / cg"
!
ignoreErrors
"turn off notification of errors"
ignoreErrors := true
!
ignoreWarnings
"turn off notification of warnings"
ignoreWarnings := true
!
isCommentCharacter:ch
"return true, if ch is the comment-start character.
Brought into a separate method to allow for easier subclassing"
^ ch == $"
"Created: / 14.5.1998 / 20:51:42 / cg"
"Modified: / 14.5.1998 / 20:53:01 / cg"
!
notifying:anObject
"set the requestor to be notified"
requestor := anObject
!
setNameSpace:aNameSpace
"/ ignored here
"Created: 8.11.1996 / 13:33:10 / cg"
! !
!Scanner methodsFor:'reading next token'!
nextCharacter
"a $ has been read - return a character token"
|nextChar|
source next.
nextChar := source next.
nextChar notNil ifTrue:[
tokenValue := token := nextChar.
tokenType := #Character.
"/ self markConstantFrom:tokenPosition to:(tokenPosition + 1).
] ifFalse:[
tokenValue := token := nil.
tokenType := #EOF
].
^ tokenType
"Modified: / 13.5.1998 / 15:09:50 / cg"
!
nextColonOrAssign
"colon has been read - look for = to make it an assign"
"/ special kludge for identifier:= (without spaces inbetween)
"/ here we needed two characters lookahead after the identifier ...
peekChar == $= ifTrue:[
source next.
peekChar := nil.
tokenType := token := #':='.
^ tokenType
].
"/ special kludge for nameSpace:: (without spaces inbetween)
"/ here we needed two characters lookahead after the identifier ...
peekChar == $: ifTrue:[
source next.
peekChar := nil.
tokenType := token :=#'::'.
^ tokenType
].
(source nextPeek == $=) ifTrue:[
source next.
tokenType := token := $_
] ifFalse:[
tokenType := token := $:
].
^ tokenType
"Modified: / 13.5.1998 / 15:10:04 / cg"
!
nextHash
|nextChar string part|
nextChar := source nextPeek.
nextChar notNil ifTrue:[
(nextChar isLetterOrDigit
or:[(allowUnderscoreInIdentifier == true) and:[nextChar == $_]]) ifTrue:[
string := ''.
[nextChar notNil
and:[nextChar isLetterOrDigit
or:[allowUnderscoreInIdentifier == true
and:[nextChar == $_]]
]
] whileTrue:[
part := source nextAlphaNumericWord.
part notNil ifTrue:[
string := string , part.
].
nextChar := source peek.
allowUnderscoreInIdentifier == true ifTrue:[
nextChar == $_ ifTrue:[
self warnUnderscoreAt:source position.
].
[nextChar == $_] whileTrue:[
string := string copyWith:nextChar.
nextChar := source nextPeek.
(nextChar isAlphaNumeric) ifTrue:[
string := string , source nextAlphaNumericWord.
nextChar := source peek.
]
].
].
(nextChar == $:) ifFalse:[
self markSymbolFrom:tokenPosition to:(source position-1).
tokenValue := token := string asSymbol.
tokenType := #Symbol.
^ tokenType
].
string := string copyWith:nextChar.
nextChar := source nextPeek
].
tokenValue := token := string asSymbol.
tokenType := #Symbol.
^ tokenType
].
(nextChar == $( ) ifTrue:[
source next.
token := '#('.
tokenType := #HashLeftParen.
^ tokenType
].
(nextChar == $[ ) ifTrue:[
"it seems that ST-80 supports Constant ByteArrays as #[...]
(seen in a PD program)"
source next.
token := '#['.
tokenType := #HashLeftBrack.
^ tokenType
].
(nextChar == $' ) ifTrue:[
"it seems that ST-80 supports arbitrary symbols as #'...'
(seen in a PD program)"
self nextString.
self markSymbolFrom:tokenPosition to:(source position-1).
tokenValue := token := tokenValue asSymbol.
tokenType := #Symbol.
^ tokenType
].
((typeArray at:(nextChar asciiValue)) == #special) ifTrue:[
string := source next asString.
nextChar := source peek.
nextChar notNil ifTrue:[
((typeArray at:(nextChar asciiValue)) == #special) ifTrue:[
source next.
string := string copyWith:nextChar
]
].
self markSymbolFrom:tokenPosition to:(source position-1).
tokenValue := token := string asSymbol.
tokenType := #Symbol.
^ tokenType
]
].
"this allows hash to be used as binop -
I dont know, if this is correct ..."
tokenName := token := '#'.
tokenType := #BinaryOperator.
^ tokenType
"
self syntaxError:'unexpected end-of-input in Symbol'
position:tokenPosition to:(tokenPosition + 1).
^ #Error
"
.
"Modified: / 1.4.1998 / 13:02:45 / cg"
!
nextId
|nextChar string oldString
index "{ Class: SmallInteger }"
max "{ Class: SmallInteger }" |
nextChar := source peekOrNil.
string := String basicNew:20.
index := 0.
max := 10.
[true] whileTrue:[
(nextChar notNil and:[nextChar isLetterOrDigit]) ifFalse:[
^ string copyTo:index
].
(index == max) ifTrue:[
oldString := string.
string := String basicNew:(max * 2).
string replaceFrom:1 to:max with:oldString.
max := max * 2
].
index := index + 1.
string at:index put:nextChar.
nextChar := source nextPeek
]
"Modified: / 5.3.1998 / 02:53:57 / cg"
!
nextIdentifier
|nextChar string ok pos|
hereChar == $_ ifTrue:[
"/
"/ no need to check for allowUnderscoreInIdentifier here;
"/ could not arrive here if it was off
"/
nextChar := source nextPeek.
(nextChar isAlphaNumeric or:[nextChar == $_]) ifFalse:[
"oops: a single underscore is an old-style assignement"
nextChar ~~ $: ifTrue:[
self warnOldStyleAssignmentAt:tokenPosition.
source next.
tokenType := token := $_.
^ tokenType
]
].
string := '_'.
self warnUnderscoreAt:tokenPosition.
[nextChar == $_] whileTrue:[
string := string copyWith:$_.
nextChar := source nextPeek.
].
nextChar isAlphaNumeric ifTrue:[
string := string , source nextAlphaNumericWord.
]
] ifFalse:[
string := source nextAlphaNumericWord "self nextId".
].
nextChar := source peekOrNil.
(nextChar == $_
or:[nextChar == $$]) ifTrue:[
ok := (nextChar == $_) ifTrue:[allowUnderscoreInIdentifier] ifFalse:[allowDollarInIdentifier].
ok ifTrue:[
pos := source position.
nextChar == $_ ifTrue:[
self warnUnderscoreAt:pos.
] ifFalse:[
self warnDollarAt:pos.
].
[ok] whileTrue:[
string := string copyWith:nextChar.
nextChar := source nextPeek.
(nextChar isAlphaNumeric) ifTrue:[
string := string , source nextAlphaNumericWord.
nextChar := source peekOrNil.
].
(nextChar == $_) ifTrue:[
ok := allowUnderscoreInIdentifier
] ifFalse:[
(nextChar == $$) ifTrue:[
ok := allowDollarInIdentifier
] ifFalse:[
ok := false
]
]
].
].
].
(nextChar == $:) ifTrue:[
source next.
(source peekOrNil == $=) ifFalse:[
(source peekOrNil == $:) ifFalse:[
tokenName := token := string copyWith:nextChar.
tokenType := #Keyword.
^ self
].
peekChar := $:.
peekChar2 := $:.
] ifTrue:[
peekChar := $:.
peekChar2 := $=.
]
].
nextChar == $- ifTrue:[
pos := source position.
self
warnPossibleIncompatibility:'add a space before ''-'' for compatibility with other systems'
position:pos to:pos.
].
tokenName := token := string.
(self checkForKeyword:string) ifTrue:[^ tokenType].
tokenType := #Identifier.
^ tokenType
"Created: / 13.9.1995 / 12:56:42 / claus"
"Modified: / 13.5.1998 / 14:58:39 / cg"
!
nextMantissa:radix
|nextChar value factor|
value := 0.
factor := 1.0 / radix.
nextChar := source peekOrNil.
[(nextChar notNil and:[nextChar isDigitRadix:radix])] whileTrue:[
value := value + (nextChar digitValue * factor).
factor := factor / radix.
nextChar := source nextPeek
].
^ value
"Modified: / 5.3.1998 / 02:54:11 / cg"
!
nextNumber
|nextChar value s tokenRadix|
tokenRadix := 10.
value := Integer readFrom:source radix:tokenRadix.
nextChar := source peekOrNil.
(nextChar == $r) ifTrue:[
tokenRadix := value.
source next.
s := 1.
source peekOrNil == $- ifTrue:[
source next.
s := -1
].
value := Integer readFrom:source radix:tokenRadix.
value := value * s.
nextChar := source peekOrNil
].
(nextChar == $.) ifTrue:[
nextChar := source nextPeek.
(nextChar notNil and:[nextChar isDigitRadix:tokenRadix]) ifTrue:[
value := value asFloat + (self nextMantissa:tokenRadix).
nextChar := source peekOrNil
] ifFalse:[
"/ nextChar == (Character cr) ifTrue:[
"/ lineNr := lineNr + 1.
"/ ].
nextChar := peekChar := $..
]
].
((nextChar == $e) or:[nextChar == $E]) ifTrue:[
nextChar := source nextPeek.
(nextChar notNil and:[(nextChar isDigitRadix:tokenRadix) or:['+-' includes:nextChar]]) ifTrue:[
s := 1.
(nextChar == $+) ifTrue:[
nextChar := source nextPeek
] ifFalse:[
(nextChar == $-) ifTrue:[
nextChar := source nextPeek.
s := s negated
]
].
value := value asFloat
* (10.0 raisedToInteger:((Integer readFrom:source radix:tokenRadix) * s))
]
].
nextChar == $- ifTrue:[
self
warnPossibleIncompatibility:'add a space before ''-'' for compatibility with other systems'
position:(source position) to:source position.
].
tokenValue := token := value.
(value isMemberOf:Float) ifTrue:[
(nextChar == $d) ifTrue:[
source next
].
tokenType := #Float
] ifFalse:[
tokenType := #Integer
].
"/ self markConstantFrom:tokenPosition to:(source position - 1).
^ tokenType
"Modified: / 1.4.1998 / 13:06:28 / cg"
!
nextPrimitive
|nextChar inPrimitive string
index "{ Class: SmallInteger }"
len "{ Class: SmallInteger }" |
nextChar := source nextPeek.
string := String new:500.
len := 500.
index := 1.
(nextChar == ${) ifTrue:[
nextChar := source nextPeek.
inPrimitive := true.
[inPrimitive] whileTrue:[
[nextChar == $%] whileFalse:[
nextChar isNil ifTrue:[
self syntaxError:'unterminated primitive'
position:tokenPosition to:source position.
^ #Error
].
string at:index put:nextChar.
(index == len) ifTrue:[
string := string , (String new:len).
len := len * 2
].
index := index + 1.
nextChar := source next
].
(source peekOrNil == $}) ifTrue:[
inPrimitive := false
] ifFalse:[
string at:index put:nextChar.
(index == len) ifTrue:[
string := string , (String new:len).
len := len * 2
].
index := index + 1.
nextChar := source next
]
].
source next.
tokenValue := token := string copyTo:(index - 1).
tokenType := #Primitive.
lineNr := lineNr + (tokenValue occurrencesOf:(Character cr)).
^ tokenType
].
"a % alone is a binary operator"
tokenName := token := '%'.
tokenType := #BinaryOperator.
^ tokenType.
"
self syntaxError:('invalid character: ''' , nextChar asString , '''')
position:tokenPosition to:(tokenPosition + 1).
^ #Error
"
"Modified: / 5.3.1998 / 02:54:43 / cg"
!
nextSpecial
"a special character has been read, look for another one.
also -number is handled here"
|firstChar secondChar thirdChar string p|
firstChar := source next.
secondChar := source peekOrNil.
((firstChar == $-) and:[secondChar notNil]) ifTrue:[
secondChar isDigit ifTrue:[
self nextNumber.
tokenValue := token := tokenValue negated.
^ tokenType
]
].
string := firstChar asString.
secondChar notNil ifTrue:[
((typeArray at:(secondChar asciiValue)) == #special) ifTrue:[
(secondChar == $-) ifTrue:[
"special- look if minus belongs to number following"
p := source position.
source next.
thirdChar := source peekOrNil.
source position:p.
thirdChar isDigit ifTrue:[
tokenName := token := string.
tokenType := #BinaryOperator.
self
warnPossibleIncompatibility:'add a space before ''-'' for compatibility with other ST systems'
position:p-1
to:p.
^ tokenType
]
].
source next.
string := string copyWith:secondChar
].
].
tokenName := token := string.
tokenType := #BinaryOperator.
^ tokenType
"Modified: / 5.3.1998 / 02:54:54 / cg"
!
nextString
|nextChar string pos
index "{ Class: SmallInteger }"
len "{ Class: SmallInteger }"
inString|
string := String basicNew:20.
len := 20.
index := 1.
pos := source position.
source next.
nextChar := source next.
inString := true.
[inString] whileTrue:[
nextChar isNil ifTrue:[
self syntaxError:'unexpected end-of-input in String'
position:pos to:(source position - 1).
self markStringFrom:pos to:source position-1.
token := nil.
tokenType := #EOF.
^ tokenType
].
(nextChar == Character cr) ifTrue:[
lineNr := lineNr + 1
].
(nextChar == Character quote) ifTrue:[
(source peekOrNil == Character quote) ifTrue:[
source next
] ifFalse:[
inString := false
]
].
inString ifTrue:[
string at:index put:nextChar.
(index == len) ifTrue:[
string := string , (String new:len).
len := len * 2
].
index := index + 1.
nextChar := source next
]
].
self markStringFrom:pos to:source position-1.
tokenValue := token := string copyTo:(index - 1).
tokenType := #String.
^ tokenType
"Modified: / 31.3.1998 / 17:33:14 / cg"
!
nextToken
"return the next token from the source-stream"
|skipping actionBlock v ch|
peekChar notNil ifTrue:[
peekChar isSeparator ifTrue:[
peekChar == (Character cr) ifTrue:[
lineNr := lineNr + 1.
].
peekChar := peekChar2.
peekChar2 := nil.
].
].
peekChar notNil ifTrue:[
ch := peekChar.
peekChar := peekChar2.
peekChar2 := nil.
hereChar := nil.
] ifFalse:[
skipping := true.
[skipping] whileTrue:[
outStream notNil ifTrue:[
hereChar := source peekOrNil.
[(hereChar == Character space)
or:[hereChar isSeparator]
] whileTrue:[
source next.
outStream space.
outCol := outCol + 1.
]
] ifFalse:[
hereChar := source skipSeparatorsExceptCR.
].
hereChar == (Character cr) ifTrue:[
lineNr := lineNr + 1.
source next.
outStream notNil ifTrue:[
outStream cr.
outCol := 1
]
] ifFalse:[
hereChar == (Character return) ifTrue:[
outStream notNil ifTrue:[
outStream nextPut:hereChar.
outCol := 1
].
source next.
] ifFalse:[
(self isCommentCharacter:hereChar) ifTrue:[
"start of a comment"
self skipComment.
hereChar := source peekOrNil.
] ifFalse:[
skipping := false
]
]
]
].
hereChar isNil ifTrue:[
token := nil.
tokenType := #EOF.
^ tokenType
].
ch := hereChar
].
tokenPosition := source position.
tokenLineNr := lineNr.
(v := ch asciiValue) == 0 ifTrue:[
v := Character space asciiValue
].
actionBlock := actionArray at:v.
actionBlock notNil ifTrue:[
^ actionBlock value:self value:ch
].
self syntaxError:('invalid character: ''' , ch asString , ''' ',
'(' , v printString , ')')
position:tokenPosition to:tokenPosition.
source next.
tokenName := nil.
tokenType := token := #Error.
^ #Error
"Modified: / 13.9.1995 / 12:56:14 / claus"
"Modified: / 14.5.1998 / 20:52:18 / cg"
!
nextToken:aCharacter
tokenType := token := aCharacter.
hereChar notNil ifTrue:[source next].
^ tokenType
"Modified: / 13.5.1998 / 15:10:23 / cg"
!
skipComment
|commentStream commentType startPos|
saveComments ifTrue:[
commentStream := WriteStream on:''.
self beginComment.
].
outStream notNil ifTrue:[
outStream nextPut:Character doubleQuote.
outCol := outCol + 1
].
startPos := source position.
source next.
hereChar := source peekOrNil.
"
special ST/X addition:
a $/ right after the initial double quote makes it an up-to-end-of-line comment,
which is very useful to comment out parts of filed-in source code.
Since this is non-standard, use it in very rare cases only.
(maybe the upcoming ansi-standard adds something similar - in this case, I will
change it without notice)"
hereChar == $/ ifTrue:[
commentType := #eolComment.
hereChar := source nextPeek.
[hereChar notNil and:[hereChar ~~ Character cr]] whileTrue:[
commentStream notNil ifTrue:[
commentStream nextPut:hereChar
].
outStream notNil ifTrue:[
outStream nextPut:hereChar.
outCol := outCol + 1
].
hereChar := source nextPeek.
].
self markCommentFrom:startPos to:(source position).
lineNr := lineNr + 1.
ignoreWarnings ifFalse:[
warnSTXSpecialComment ifTrue:[
self warning:'end-of-line comments are a nonstandard feature of ST/X'
position:startPos to:(source position).
"
only warn once
"
warnSTXSpecialComment := false
]
].
outStream notNil ifTrue:[
outStream cr.
outCol := 1
].
] ifFalse:[
commentType := #regularComment.
hereChar == ${ ifTrue:[
"
special ST/X addition:
a ${ right after the initial double quote starts a directive
"
self parseDirective
].
[hereChar notNil and:[hereChar ~~ (Character doubleQuote)]] whileTrue:[
hereChar == (Character cr) ifTrue:[
lineNr := lineNr + 1.
].
commentStream notNil ifTrue:[
commentStream nextPut:hereChar
].
outStream notNil ifTrue:[
outStream nextPut:hereChar.
outCol := outCol + 1
].
hereChar := source nextPeek
].
hereChar isNil ifTrue:[
self markCommentFrom:startPos to:(source size).
self warning:'unclosed comment' position:startPos to:(source position)
] ifFalse:[
self markCommentFrom:startPos to:(source position).
outStream notNil ifTrue:[
outStream nextPut:(Character doubleQuote).
outCol := outCol + 1
].
]
].
"skip final dQuote or cr"
source next.
saveComments ifTrue:[
self endComment:(commentStream contents) type:commentType.
].
"Modified: / 31.3.1998 / 23:45:26 / cg"
! !
!Scanner::Comment methodsFor:'accessing'!
commentString
"return the value of the instance variable 'commentString' (automatically generated)"
^ commentString
"Created: / 17.2.1998 / 14:44:33 / cg"
!
commentString:something
"set the value of the instance variable 'commentString' (automatically generated)"
commentString := something.
"Created: / 17.2.1998 / 14:44:33 / cg"
!
commentType
"return the value of the instance variable 'commentType' (automatically generated)"
^ commentType
"Created: / 17.2.1998 / 14:44:33 / cg"
!
commentType:something
"set the value of the instance variable 'commentType' (automatically generated)"
commentType := something.
"Created: / 17.2.1998 / 14:44:33 / cg"
!
string
^ commentString
"Created: / 17.2.1998 / 14:49:52 / cg"
! !
!Scanner class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.84 1998-05-16 13:56:39 cg Exp $'
! !
Scanner initialize!