Scanner.st
changeset 87 f05dac458d20
parent 83 10c73a059351
child 89 f0c8faf27ceb
--- a/Scanner.st	Wed May 10 04:27:38 1995 +0200
+++ b/Scanner.st	Fri May 12 19:30:55 1995 +0200
@@ -20,10 +20,12 @@
 			      ignoreErrors ignoreWarnings
 			      saveComments currentComments
 			      warnSTXSpecialComment warnUnderscoreInIdentifier
+			      warnOldStyleAssignment
 			      outStream outCol'
 	  classVariableNames:'TypeArray ActionArray 
 			      AllowUnderscoreInIdentifier
-			      Warnings WarnSTXSpecials
+			      Warnings 
+			      WarnSTXSpecials WarnOldStyleAssignment
 			      WarnUnderscoreInIdentifier'
 	    poolDictionaries:''
 		    category:'System-Compiler'
@@ -33,7 +35,7 @@
 COPYRIGHT (c) 1989 by Claus Gittinger
 	     All Rights Reserved
 
-$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.25 1995-04-11 15:30:25 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.26 1995-05-12 17:30:55 claus Exp $
 '!
 
 !Scanner class methodsFor:'documentation'!
@@ -54,7 +56,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.25 1995-04-11 15:30:25 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.26 1995-05-12 17:30:55 claus Exp $
 "
 !
 
@@ -125,6 +127,22 @@
     WarnUnderscoreInIdentifier := aBoolean
 !
 
+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
+!
+
 allowUnderscoreInIdentifier
     "return true, if underscores are allowed in identifiers"
 
@@ -152,6 +170,7 @@
     Warnings := true.
     WarnSTXSpecials := true.
     WarnUnderscoreInIdentifier := true.
+    WarnOldStyleAssignment := true.
     AllowUnderscoreInIdentifier := false.
 !
 
@@ -166,6 +185,17 @@
 	ActionArray at:index put:block
     ].
 
+    block := [:s :char | s nextSpecial].
+    #( $& $- $+ $= $* $/ $\ $< $> $~ $@ $, $? ) do:[:binop |
+	TypeArray at:(binop asciiValue) put:#special.
+	ActionArray at:(binop asciiValue) put:block
+    ].
+
+    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
@@ -177,17 +207,6 @@
 	ActionArray at:$_ asciiValue put:block
     ].
 
-    block := [:s :char | s nextSpecial].
-    #( $& $- $+ $= $* $/ $\ $< $> $~ $@ $, $? ) do:[:binop |
-	TypeArray at:(binop asciiValue) put:#special.
-	ActionArray at:(binop asciiValue) put:block
-    ].
-
-    block := [:s :char | s nextToken:char].
-    #( $; $. $( $) $[ $] $!! $^ $| $_ ) do:[:ch |
-	ActionArray at:(ch asciiValue) put:block
-    ].
-
     "kludge: action is characterToken, but type is special"
     TypeArray at:($| asciiValue) put:#special.
 
@@ -231,6 +250,7 @@
     ignoreWarnings := Warnings not.
     warnSTXSpecialComment := WarnSTXSpecials.
     warnUnderscoreInIdentifier := WarnUnderscoreInIdentifier.
+    warnOldStyleAssignment := WarnOldStyleAssignment.
     ActionArray isNil ifTrue:[
 	self class setupActions
     ]
@@ -452,6 +472,34 @@
     "a warning - position is not known"
 
     ^ self warning:aMessage position:tokenPosition
+!
+
+warnOldStyleAssignmentAt:position
+    ignoreWarnings ifFalse:[
+	warnOldStyleAssignment ifTrue:[
+	    self 
+		warning:'old style assignment - please change to use '':='''
+		position:position to:position.
+	    "
+	     only warn once (per method)
+	    "
+	    warnOldStyleAssignment := false
+	]
+    ]
+!
+
+warnUnderscoreAt:position
+    ignoreWarnings ifFalse:[
+	warnUnderscoreInIdentifier ifTrue:[
+	    self 
+		warning:'underscores in identifiers/symbols are nonportable' 
+		position:position to:position.
+	    "
+	     only warn once (per method)
+	    "
+	    warnUnderscoreInIdentifier := false
+	]
+    ]
 ! !
 
 !Scanner methodsFor:'general scanning'!
@@ -815,22 +863,36 @@
 !
 
 nextIdentifier
-    |nextChar string firstChar|
+    |nextChar string firstChar pos|
 
-    string := source nextAlphaNumericWord "self nextId".
+    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"
+	    self warnOldStyleAssignmentAt:tokenPosition.
+	    source next.
+	    tokenType := $_.
+	    ^ tokenType
+	].
+	string := '_'.
+	self warnUnderscoreAt:tokenPosition.
+	[nextChar == '_'] whileTrue:[
+	    string := string copyWith:$_.
+	    nextChar := source nextPeek.
+	].
+	string := string , source nextAlphaNumericWord.
+    ] ifFalse:[
+	string := source nextAlphaNumericWord "self nextId".
+    ].
     nextChar := source peek.
+
     AllowUnderscoreInIdentifier ifTrue:[
 	nextChar == $_ ifTrue:[
-	    ignoreWarnings ifFalse:[
-		warnUnderscoreInIdentifier ifTrue:[
-		    self warning:'underscores in identifiers are nonportable' 
-			position:(source position) to:(source position).
-		    "
-		     only warn once
-		    "
-		    warnUnderscoreInIdentifier := false
-		]
-	    ]
+	    self warnUnderscoreAt:(source position).
 	].
 	[nextChar == $_] whileTrue:[
 	    string := string copyWith:nextChar.
@@ -935,16 +997,7 @@
 		nextChar := source peek.
 		AllowUnderscoreInIdentifier == true ifTrue:[
 		    nextChar == $_ ifTrue:[
-			ignoreWarnings ifFalse:[
-			    warnUnderscoreInIdentifier ifTrue:[
-				self warning:'underscores in symbols are nonportable' 
-				    position:source position to:source position.
-				"
-				 only warn once
-				"
-				warnUnderscoreInIdentifier := false
-			    ]
-			]
+			self warnUnderscoreAt:source position.
 		    ].
 		    [nextChar == $_] whileTrue:[
 			string := string copyWith:nextChar.