'From Squeak3.11alpha of 13 February 2010 [latest update: #9483] on 9 March 2010 at 11:11:23 am'! ParserNotification subclass: #AmbiguousSelector instanceVariableNames: 'interval' classVariableNames: '' poolDictionaries: '' category: 'Compiler-Exceptions'! !AmbiguousSelector commentStamp: 'nice 2/23/2010 15:40' prior: 0! An AmbiguousSelector is a notification produced by the Scanner/Parser/Compiler when encountering this ambiguous construct: 1@-2 Upper expression can be interpreted both 1 @ -2 (regular st-80 and former Squeak syntax, the minus is attached to the literal number) 1 @- 2 (extended binary selector, the minus sign is allowed at any position and thus part of the binary selector) ! !ParserNotification methodsFor: 'handling' stamp: 'cwp 10/17/2007 21:36'! openMenuIn: aBlock self subclassResponsibility! ! !ParserNotification methodsFor: 'private' stamp: 'cwp 10/17/2007 23:29/eem 9/5/2009 11:10 - => :='! setName: aString name := aString! ! !AmbiguousSelector methodsFor: 'handling' stamp: 'nice 2/23/2010 16:54'! openMenuIn: aBlock "Ask the user which selector to choose. Answer the choosen selector or nil if cancellation is requested." | labels actions lines caption choice | labels := { 'selector is ' , (name copyFrom: 1 to: name size - 1) , ' argument is negative'. 'selector is ' , name , ' argument is positive'. 'cancel'}. actions := { name copyReplaceFrom: name size to: name size - 1 with: ' '. name copyReplaceFrom: name size + 1 to: name size with: ' '. nil. }. lines := {2}. caption := 'Ambiguous selector: ' , name , ' please correct, or cancel:'. choice := aBlock value: labels value: lines value: caption. self resume: (actions at: choice ifAbsent: [nil])! ! !AmbiguousSelector methodsFor: 'private' stamp: 'nice 2/23/2010 16:51'! setName: aString range: anInterval name := aString. interval := anInterval! ! !AmbiguousSelector class methodsFor: 'instance creation' stamp: 'nice 2/23/2010 16:52'! signalName: aString inRange: anInterval ^ (self new setName: aString range: anInterval) signal! ! !Scanner methodsFor: 'error handling' stamp: 'nice 2/25/2010 02:56'! notify: string at: posiiton "Parser compatible message" ^self notify: string ! ! !Scanner methodsFor: 'expression types' stamp: 'nice 2/23/2010 21:38'! scanToken [(tokenType := self typeTableAt: hereChar) == #xDelimiter] whileTrue: [self step]. "Skip delimiters fast, there almost always is one." mark := (aheadChar == 30 asCharacter and: [source atEnd]) ifTrue: [source position] ifFalse: [source position - 1]. (tokenType at: 1) = $x "x as first letter" ifTrue: [self perform: tokenType "means perform to compute token & type"] ifFalse: [token := self step asSymbol "else just unique the first char"]. ^token! ! !Scanner methodsFor: 'multi-character scans' stamp: 'nice 2/23/2010 16:39'! xBinary | startOfToken | tokenType := #binary. startOfToken := mark. token := String with: self step. [(self typeTableAt: hereChar) == #xBinary] whileTrue: [(hereChar == $- and: [(self typeTableAt: aheadChar) == #xDigit]) ifTrue: [^self ambiguousSelector: (token , '-') inRange: (startOfToken to: source position - 1).]. token := token, (String with: self step)]. token := token asSymbol! ! !Scanner methodsFor: 'multi-character scans' stamp: 'nice 2/25/2010 02:43'! xDigit "Form a number." tokenType := #number. (aheadChar = 30 asCharacter and: [source atEnd and: [source skip: -1. source next ~= 30 asCharacter]]) ifTrue: [source skip: -1 "Read off the end last time"] ifFalse: [source skip: -2]. token := (SqNumberParser on: source) failBlock: [:errorString :position | self notify: errorString at:position]; nextNumber. self step; step! ! !Parser methodsFor: 'error correction' stamp: 'nice 2/25/2010 01:50'! ambiguousSelector: aString inRange: anInterval | correctedSelector userSelection | self interactive ifFalse: [ "In non interactive mode, compile with backward comapatibility: $- is part of literal argument" Transcript cr; store: encoder classEncoding; nextPutAll:#'>>';store: encoder selector; show: ' would send ' , token , '-'. token := token asSymbol. ^self]. "handle the text selection" userSelection := requestor selectionInterval. requestor selectFrom: anInterval first to: anInterval last. requestor select. "Build the menu with alternatives" correctedSelector := AmbiguousSelector signalName: aString inRange: anInterval. correctedSelector ifNil: [^self fail]. "Execute the selected action" self substituteWord: correctedSelector wordInterval: anInterval offset: 0. requestor deselect. requestor selectInvisiblyFrom: userSelection first to: userSelection last + 1. token := (correctedSelector readStream upTo: Character space) asSymbol! ! !Parser methodsFor: 'error handling' stamp: 'nice 2/26/2010 00:21'! fail | exitBlock | (encoder == nil or: [encoder == self]) ifFalse: [encoder release. encoder := nil]. "break cycle" exitBlock := failBlock. failBlock := nil. ^exitBlock value! ! !Parser methodsFor: 'error handling' stamp: 'nice 2/24/2010 02:21'! notify: string at: location requestor isNil ifTrue: [(encoder == self or: [encoder isNil]) ifTrue: [^ self fail "failure setting up syntax error"]. SyntaxErrorNotification inClass: encoder classEncoding category: category withCode: (source contents asText copyReplaceFrom: location to: location - 1 with: ((string , ' ->') asText allBold addAttribute: TextColor red; yourself)) doitFlag: doitFlag errorMessage: string location: location] ifFalse: [requestor notify: string , ' ->' at: location in: source]. ^self fail! ! !Parser methodsFor: 'expression types' stamp: 'nice 2/25/2010 17:52'! method: doit context: ctxt " pattern [ | temporaries ] block => MethodNode." | sap blk prim temps messageComment methodNode | sap := self pattern: doit inContext: ctxt. "sap={selector, arguments, precedence}" self properties selector: (sap at: 1). encoder selector: (sap at: 1). (sap at: 2) do: [:argNode | argNode beMethodArg]. doit ifFalse: [self pragmaSequence]. temps := self temporaries. messageComment := currentComment. currentComment := nil. doit ifFalse: [self pragmaSequence]. prim := self pragmaPrimitives. self statements: #() innerBlock: doit. blk := parseNode. doit ifTrue: [blk returnLast] ifFalse: [blk returnSelfIfNoOther: encoder]. hereType == #doIt ifFalse: [^self expected: 'Nothing more']. self interactive ifTrue: [self removeUnusedTemps]. methodNode := self newMethodNode comment: messageComment. ^methodNode selector: (sap at: 1) arguments: (sap at: 2) precedence: (sap at: 3) temporaries: temps block: blk encoder: encoder primitive: prim properties: properties! ! !Parser methodsFor: 'expression types' stamp: 'nice 2/25/2010 17:52'! method: doit context: ctxt encoder: encoderToUse " pattern [ | temporaries ] block => MethodNode." encoder := encoderToUse. ^self method: doit context: ctxt! ! !Parser methodsFor: 'expression types' stamp: 'nice 2/24/2010 01:20'! primaryExpression hereType == #word ifTrue: [parseNode := self variable. (parseNode isUndefTemp and: [self interactive]) ifTrue: [self queryUndefined]. parseNode nowHasRef. ^ true]. hereType == #leftBracket ifTrue: [self advance. self blockExpression. ^true]. hereType == #leftBrace ifTrue: [self braceExpression. ^true]. hereType == #leftParenthesis ifTrue: [self advance. self expression ifFalse: [^self expected: 'expression']. (self match: #rightParenthesis) ifFalse: [^self expected: 'right parenthesis']. ^true]. (hereType == #string or: [hereType == #number or: [hereType == #literal]]) ifTrue: [parseNode := encoder encodeLiteral: self advance. ^true]. (here == #- and: [tokenType == #number and: [1 + hereEnd = mark]]) ifTrue: [self advance. parseNode := encoder encodeLiteral: self advance negated. ^true]. ^false! ! !Parser methodsFor: 'public access' stamp: 'nice 2/25/2010 17:52'! parse: sourceStream class: class category: aCategory noPattern: noPattern context: ctxt notifying: req ifFail: aBlock "Answer a MethodNode for the argument, sourceStream, that is the root of a parse tree. Parsing is done with respect to the argument, class, to find instance, class, and pool variables; and with respect to the argument, ctxt, to find temporary variables. Errors in parsing are reported to the argument, req, if not nil; otherwise aBlock is evaluated. The argument noPattern is a Boolean that is true if the the sourceStream does not contain a method header (i.e., for DoIts)." | methNode repeatNeeded myStream s p | category := aCategory. myStream := sourceStream. [repeatNeeded := false. p := myStream position. s := myStream upToEnd. myStream position: p. self encoder init: class context: ctxt notifying: self. self init: myStream notifying: req failBlock: [^ aBlock value]. doitFlag := noPattern. failBlock:= aBlock. [methNode := self method: noPattern context: ctxt] on: ReparseAfterSourceEditing do: [ :ex | repeatNeeded := true. myStream := ReadStream on: requestor text string]. repeatNeeded] whileTrue: [encoder := self encoder class new]. methNode sourceText: s. ^methNode ! ! !Parser methodsFor: 'scanning' stamp: 'nice 2/24/2010 01:36'! advance | this | prevMark := hereMark. prevEnd := hereEnd. this := here. here := token. hereType := tokenType. hereMark := mark. hereEnd := source position - ((aheadChar == 30 asCharacter and: [source atEnd]) ifTrue: [hereChar == 30 asCharacter ifTrue: [0] ifFalse: [1]] ifFalse: [2]). self scanToken. "Transcript show: 'here: ', here printString, ' mark: ', hereMark printString, ' end: ', hereEnd printString; cr." ^this! ! !Parser methodsFor: 'private' stamp: 'nice 2/23/2010 17:48'! init: sourceStream notifying: req failBlock: aBlock requestor := req. failBlock := aBlock. requestorOffset := 0. super scan: sourceStream. prevMark := hereMark := mark. self advance! ! !UndeclaredVariable class methodsFor: 'instance creation' stamp: 'cwp 10/15/2007 22:37'! signalFor: aParser name: aString inRange: anInterval ^ (self new setParser: aParser name: aString range: anInterval) signal! !