Parser.st
changeset 3291 6d3aa0cbac53
parent 3289 81f10f1ae8c3
child 3292 6031667026eb
--- a/Parser.st	Mon Aug 26 15:44:37 2013 +0200
+++ b/Parser.st	Mon Aug 26 17:20:44 2013 +0200
@@ -106,6 +106,13 @@
 	privateIn:Parser
 !
 
+Parser::Correction subclass:#CorrectByMakingValidHexConstant
+	instanceVariableNames:'receiverNode selector'
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:Parser
+!
+
 Parser::Correction subclass:#CorrectByChangingSelector
 	instanceVariableNames:'receiverNode receiverClass selector'
 	classVariableNames:''
@@ -2150,6 +2157,15 @@
     ^ correctedSource
 !
 
+currentSource
+    "return either the corrected or the requestors original source"
+
+    correctedSource notNil ifTrue:[
+        ^ correctedSource
+    ].
+    ^ requestor currentSourceCode
+!
+
 doItTemporaries
     ^ doItTemporaries
 !
@@ -3056,26 +3072,32 @@
         possibleSplits := OrderedCollection new.
         parts := aSelectorString partsIfSelector.
         1 to:parts size-1 size do:[:sepIdx |
-            |msg1 msg2|
+            |msg1 msg2 msg1Ok msg2Ok|
 
             msg1 := (parts copyTo:sepIdx) asStringWith:''.
             msg2 := (parts copyFrom:sepIdx+1) asStringWith:''.
             (msg1 := msg1 asSymbolIfInterned) notNil ifTrue:[
                 (msg2 := msg2 asSymbolIfInterned) notNil ifTrue:[
                     aClassOrNil notNil ifTrue:[
-                        ((aClassOrNil canUnderstand:msg1) 
-                        and:[ (SystemBrowser
-                                findImplementorsOf: selector
+                        msg1Ok := aClassOrNil canUnderstand:msg1
+                    ] ifFalse:[
+                        msg1Ok := (SystemBrowser
+                                findImplementorsOf: msg1
                                 in: Smalltalk allClasses
-                                ignoreCase: false) notEmpty 
-                        ]) ifTrue:[
-                            possibleSplits add:{ msg1 . msg2 }
-                        ].
+                                ignoreCase: false) notEmpty.
+                    ].
+                    msg2Ok := (SystemBrowser
+                                findImplementorsOf: msg2
+                                in: Smalltalk allClasses
+                                ignoreCase: false) notEmpty.
+
+                    (msg1Ok and:[msg2Ok]) ifTrue:[
+                        possibleSplits add:{ msg1 . msg2 }
                     ] ifFalse:[
-self halt.
+self breakPoint:#cg.
                     ]
                 ] ifFalse:[
-self halt.
+self breakPoint:#cg.
                 ]
             ].
         ].
@@ -3086,13 +3108,24 @@
         ].
     ].
 
-    "/ a hack - don't like looking into string; needs fix
+    "/ a hack - don't like looking into string; needs fix (caller must pass in possible corrections)
     (msg includesString:'issing ''.''') ifTrue:[
         receiverNode notNil ifTrue:[
             positionOfPeriod := receiverNode endPosition.
             fixes := fixes copyWith: CorrectByInsertingPeriod.
         ].
     ].
+    (msg includesString:'hex integer') ifTrue:[
+        (receiverNode notNil
+        and:[ receiverNode isConstant
+        and:[ receiverNode value == 0
+        and:[ (aSelectorString asLowercase startsWith:'x')
+        and:[ aSelectorString from:2 conform:[:ch | ch isDigitRadix:16]
+        ]]]]) ifTrue:[
+            fixes := fixes copyWith:CorrectByMakingValidHexConstant
+        ].
+    ].
+
     PossibleCorrectionsQuery answer:fixes do:[
         correctIt := self correctableWarning:msg position:pos1 to:pos2.
     ].
@@ -3365,7 +3398,7 @@
      get the updated source-string
      which is needed, when we eventually install the new method
     "
-    correctedSource := requestor currentSourceCode.
+    correctedSource := self currentSource.
     source := (ReadStream on:correctedSource)
                   position:(source position + 1 + newName size - tokenName size).
 
@@ -3392,6 +3425,7 @@
     newSource := correctionOperation fixFrom:pos1 to:pos2 for:self.
     newSource notNil ifTrue:[
         correctedSource := newSource.
+        requestor contents:newSource.
         RestartCompilationSignal raiseRequest.
     ].
     ^ #Error
@@ -3490,6 +3524,7 @@
             requestor
                 insertString:ins
                 atCharacterPosition:posToInsert.
+            correctedSource := requestor currentSourceCode asString string.
 
             endLocalsPos notNil ifTrue:[
                 localVarDefPosition at:2 put:(endLocalsPos + varName size + 1).
@@ -3502,7 +3537,6 @@
                 methodVarNames := Array with:varName.
                 methodVars := Array with:(var := Variable new name:varName).
             ].
-            correctedSource := requestor currentSourceCode asString string.
             source := (ReadStream on:correctedSource)
                           position:(source position + 1 + ins size).
 
@@ -3563,7 +3597,7 @@
     varSlot := methodVars detect:[:var | var name = varName].
     methodVars removeIdentical:varSlot.
 
-    source := requestor currentSourceCode.
+    source := self currentSource.
 
     defStartPos := defStartPosArg.
     defEndPos := defEndPosArg.
@@ -3917,9 +3951,9 @@
     requestor isNil ifTrue:[
         ^ aSelectorString
     ].
-"/    (parserFlags warnAboutPossiblyUnimplementedSelectors ifFalse:[
-"/        ^ aSelectorString
-"/    ].
+    parserFlags warnAboutPossiblyUnimplementedSelectors ifFalse:[
+        ^ aSelectorString
+    ].
 
     "
      check if the selector is known at all
@@ -3956,23 +3990,6 @@
         ].
 
         err := ' is currently nowhere implemented'.
-
-        "
-         if the selector has the name of a variable, use another message
-        "
-        ((methodVarNames notNil and:[methodVarNames includes:aSelectorString])
-          or:[(methodArgNames notNil and:[methodArgNames includes:aSelectorString])
-          or:[classToCompileFor notNil
-              and:[((names := self classesInstVarNames) notNil and:[names includes:aSelectorString])
-                   or:[((names := self classesClassInstVarNames) notNil and:[names includes:aSelectorString])
-                   or:[(names := self classesClassVarNames) notNil and:[names includes:aSelectorString]
-        ]]]]]) ifTrue:[
-            err := ' is currently nowhere implemented ..
-.. but a variable with that name is defined.
-
-Missing ''.'' after the previous expression
-or missing keyword/receiver before that word ?'.
-        ].
     ] ifFalse:[
         receiver notNil ifTrue:[
             selClass := self typeOfNode:receiver.
@@ -4116,15 +4133,39 @@
         ]
     ].
 
-    parserFlags warnAboutPossiblyUnimplementedSelectors ifFalse:[
-        ^ aSelectorString
-    ].
-
     err notNil ifTrue:[
+        "
+         if the selector has the name of a variable, use another message
+        "
+        ((methodVarNames notNil and:[methodVarNames includes:aSelectorString])
+          or:[(methodArgNames notNil and:[methodArgNames includes:aSelectorString])
+          or:[classToCompileFor notNil
+              and:[((names := self classesInstVarNames) notNil and:[names includes:aSelectorString])
+                   or:[((names := self classesClassInstVarNames) notNil and:[names includes:aSelectorString])
+                   or:[(names := self classesClassVarNames) notNil and:[names includes:aSelectorString]
+        ]]]]]) ifTrue:[
+            err := err , '
+    .. but a variable with that name is defined.
+
+    Missing ''.'' after the previous expression
+    or missing keyword/receiver before that word ?'.
+        ].
+
+        ((selectorSymbol startsWith:'x') or:[selectorSymbol startsWith:'X']) and:[
+            (selectorSymbol from:2 conform:[:ch | ch isDigitRadix:16]) ifTrue:[
+                (receiver isConstant 
+                and:[ receiver value == 0
+                and:[ receiver startPosition == receiver endPosition "/ single digit
+                ]]) ifTrue:[
+                    err := err, ('\\or did you mean a C/Java hex integer (which should be 16r',(selectorSymbol from:2),' in Smalltalk)')
+                ].
+            ].
+        ].
+
         (receiver notNil
         and:[((recType := receiver type) == #GlobalVariable)
              or:[recType == #PrivateClass]]) ifTrue:[
-            "/ dont check autoloaded classes
+            "/ don't check autoloaded classes
             "/ - it may work after loading
 
             rec := receiver evaluate.
@@ -8022,59 +8063,69 @@
     (receiver == #Error) ifTrue:[^ #Error].
 
     [ self isValidUnarySelector:tokenType ] whileTrue:[
-	pos := tokenPosition.
-	pos2 := pos + tokenName size - 1.
-	lNr := tokenLineNr.
-	sel := tokenName.
-
-	self markSelector:sel from:pos to:pos2 receiverNode:receiver.
-
-	self nextToken.
-	tokenType == $( ifTrue:[
-	    parserFlags allowSqueakExtensions == true ifTrue:[
-		"/ croquet/squeak extension - c/java-style arguments
-		arguments := self functionCallArgList.
-		(arguments == #Error) ifTrue:[^ #Error].
-		"/ synthetic selector: foo[:[with:[with:[...]]]]
-		arguments notEmpty ifTrue:[
-		    sel := sel , ':'.
-		    arguments size - 1 timesRepeat:[ sel := sel , 'with:' ].
-		].
-		sel := self selectorCheck:sel for:receiver position:pos to:pos2.
-		expr := MessageNode receiver:receiver selector:sel args:arguments fold:foldConstants.
-		expr isErrorNode ifTrue:[
-		    self parseError:(expr errorString) position:pos to:pos2.
-		    errorFlag := false. "ok, user wants it - so he'll get it"
-		    expr := MessageNode receiver:receiver selector:sel args:arguments fold:nil.
-		].
-		expr lineNumber:lNr.
-
-		self checkPlausibilityOf:expr from:pos to:pos2.
-		parseForCode ifFalse:[
-		    self rememberSelectorUsed:sel receiver:receiver
-		].
-		^ expr.
-	    ].
-	].
-
-	sel := self selectorCheck:sel for:receiver position:pos to:pos2.
-	expr := UnaryNode receiver:receiver selector:sel fold:foldConstants.
-	expr startPosition: receiver startPosition endPosition: pos2.
-	expr isErrorNode ifTrue:[
-	    self warning:(expr errorString , '.\\If you proceed, that error will happen at runtime.') withCRs position:pos to:pos2.
-	    errorFlag := false. "ok, user wants it - so he'll get it"
-	    expr := UnaryNode receiver:receiver selector:sel fold:nil.
-	    expr startPosition: receiver startPosition endPosition: pos2.
-	].
-	expr lineNumber:lNr.
-
-	self checkPlausibilityOf:expr from:pos to:pos2.
-	parseForCode ifFalse:[
-	    self rememberSelectorUsed:sel receiver:receiver
-	].
-
-	expr := self messageNodeRewriteHookFor:expr.
-	receiver := expr.   "/ for next message
+        pos := tokenPosition.
+        pos2 := pos + tokenName size - 1.
+        lNr := tokenLineNr.
+        sel := tokenName.
+
+        self markSelector:sel from:pos to:pos2 receiverNode:receiver.
+
+        self nextToken.
+        tokenType == $( ifTrue:[
+            parserFlags allowSqueakExtensions == true ifTrue:[
+                "/ croquet/squeak extension - c/java-style arguments
+                arguments := self functionCallArgList.
+                (arguments == #Error) ifTrue:[^ #Error].
+                "/ synthetic selector: foo[:[with:[with:[...]]]]
+                arguments notEmpty ifTrue:[
+                    sel := sel , ':'.
+                    arguments size - 1 timesRepeat:[ sel := sel , 'with:' ].
+                ].
+                sel := self selectorCheck:sel for:receiver position:pos to:pos2.
+                expr := MessageNode receiver:receiver selector:sel args:arguments fold:foldConstants.
+                expr isErrorNode ifTrue:[
+                    self parseError:(expr errorString) position:pos to:pos2.
+                    errorFlag := false. "ok, user wants it - so he'll get it"
+                    expr := MessageNode receiver:receiver selector:sel args:arguments fold:nil.
+                ].
+                expr lineNumber:lNr.
+
+                self checkPlausibilityOf:expr from:pos to:pos2.
+                parseForCode ifFalse:[
+                    self rememberSelectorUsed:sel receiver:receiver
+                ].
+                ^ expr.
+            ].
+        ].
+
+        "/ create the expression before (corrector may need it)
+        expr := UnaryNode receiver:receiver selector:sel fold:foldConstants.
+
+        "/ attention: may have been optimized (Character return -> const!!
+        expr isMessage ifTrue:[
+            expr selectorPosition:pos.
+            expr startPosition: receiver startPosition endPosition: pos2.
+
+            sel := self selectorCheck:sel for:receiver position:pos to:pos2.
+
+            expr selector:sel.  "/ update possibly changed selector.
+        ].
+
+        expr isErrorNode ifTrue:[
+            self warning:(expr errorString , '.\\If you proceed, that error will happen at runtime.') withCRs position:pos to:pos2.
+            errorFlag := false. "ok, user wants it - so he'll get it"
+            expr := UnaryNode receiver:receiver selector:sel fold:nil.
+            expr startPosition: receiver startPosition endPosition: pos2.
+        ].
+        expr lineNumber:lNr.
+
+        self checkPlausibilityOf:expr from:pos to:pos2.
+        parseForCode ifFalse:[
+            self rememberSelectorUsed:sel receiver:receiver
+        ].
+
+        expr := self messageNodeRewriteHookFor:expr.
+        receiver := expr.   "/ for next message
     ].
     ^ receiver
 
@@ -10646,7 +10697,7 @@
 fixFrom:pos1 to:pos2 for:aCompiler
     |source varName|
 
-    source := aCompiler requestor currentSourceCode.
+    source := aCompiler currentSource.
     varName := source copyFrom:pos1 to:pos2.
     aCompiler deleteDefinitionOf:varName in:pos1 to:pos2.
 self halt.
@@ -10695,9 +10746,9 @@
         className size == 0 ifTrue:[
             ^ nil
         ].
-        classToGenerateCode := Smalltalk at:className asSymbol.
+        classToGenerateCode := Smalltalk classNamed:className.
         classToGenerateCode isNil ifTrue:[
-            self warn:'No such class.'.
+            self warn:'Oops: No such class: ',className.
             ^ nil
         ].
     ].
@@ -10788,7 +10839,7 @@
         split := possibleSplits first.
     ].
 
-    source := aCompiler requestor currentSourceCode.
+    source := aCompiler currentSource.
     numParts1 := split first partsIfSelector size.
     source := source string.
     source1 := source copyTo:(selectorPositions at:numParts1) stop.
@@ -10818,7 +10869,7 @@
 
     |source newSource|
 
-    source := aCompiler requestor currentSourceCode.
+    source := aCompiler currentSource.
     newSource := source copyWithAll:'.' insertedAfterIndex:positionOfPeriod.
     ^ newSource
 ! !
@@ -10850,7 +10901,7 @@
 
     |badName source newName node definingNode refactoring|
 
-    source := aCompiler requestor currentSourceCode.
+    source := aCompiler currentSource.
     badName := source copyFrom:pos1 to:pos2.
 
     node := DoWhatIMeanSupport
@@ -10893,6 +10944,35 @@
     ^ refactoring newSource
 ! !
 
+!Parser::CorrectByMakingValidHexConstant class methodsFor:'queries'!
+
+buttonLabel
+    ^ 'Correct Hex Constant'
+! !
+
+!Parser::CorrectByMakingValidHexConstant methodsFor:'accessing'!
+
+receiverNode:something
+    receiverNode := something.
+!
+
+selector:something
+    selector := something.
+! !
+
+!Parser::CorrectByMakingValidHexConstant methodsFor:'correcting'!
+
+fixFrom:pos1 to:pos2 for:aCompiler
+    "a selector needs to be changed in a message send"
+
+    |source newSource|
+
+    source := aCompiler currentSource string.
+
+    newSource := (source copyTo:receiverNode startPosition - 1),'16r',(selector copyFrom:2),(source copyFrom:receiverNode parent selectorPosition + selector size).
+    ^ newSource.
+! !
+
 !Parser::CorrectByChangingSelector class methodsFor:'queries'!
 
 buttonLabel
@@ -11523,11 +11603,11 @@
 !Parser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.778 2013-08-26 13:43:16 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.779 2013-08-26 15:20:44 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.778 2013-08-26 13:43:16 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.779 2013-08-26 15:20:44 cg Exp $'
 !
 
 version_SVN