'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5566] on 6 January 2004 at 4:43:48 pm'!
"Change Set:		PositionalArgs
Date:			4 December 2003
Author:			Andreas Raab

This is the update changeset 482 from croquet with some minor modifications to make it work in squeak 3.7 -- laza

This is original preamble text:

These changes allow the use of 'positional arguments' for messages. E.g., you're now capable of saying foo(1, 2, 3). It is intended for interfacing with existing APIs (such as OpenGL) where the 'extra keywords' introduced are neither helpful nor documented in any existing books, examples, whatever."!


!Scanner methodsFor: 'multi-character scans' stamp: 'ar 11/12/2003 21:35'!
xLetter
	"Form a word or keyword."

	| type |
	buffer reset.
	[(type _ typeTable at: hereChar asciiValue) == #xLetter or: [type == #xDigit]]
		whileTrue:
			["open code step for speed"
			buffer nextPut: hereChar.
			hereChar _ aheadChar.
			source atEnd
				ifTrue: [aheadChar _ 30 asCharacter "doit"]
				ifFalse: [aheadChar _ source next]].
	(type == #colon or: [type == #xColon and: [aheadChar ~= $=]])
		ifTrue: 
			[buffer nextPut: self step.
			["Allow any number of embedded colons in literal symbols"
			(typeTable at: hereChar asciiValue) == #xColon]
				whileTrue: [buffer nextPut: self step].
			tokenType _ #keyword]
		ifFalse: 
			[type == #leftParenthesis 
				ifTrue:[buffer nextPut: self step; nextPut: $).
						tokenType _ #positionalMessage]
				ifFalse:[tokenType _ #word]].
	token _ buffer contents! !


!Parser methodsFor: 'expression types' stamp: 'laza 12/23/2003 10:35'!
messagePart: level repeat: repeat

	| start receiver selector args precedence words keywordStart type |
	[receiver _ parseNode.
	(hereType == #keyword and: [level >= 3])
		ifTrue: 
			[start _ self startOfNextToken.
			selector _ WriteStream on: (String new: 32).
			args _ OrderedCollection new.
			words _ OrderedCollection new.
			[hereType == #keyword]
				whileTrue: 
					[keywordStart _ self startOfNextToken + requestorOffset.
					selector nextPutAll: self advance.
					words addLast: (keywordStart to: self endOfLastToken + requestorOffset).
					self primaryExpression ifFalse: [^self expected: 'Argument'].
					self messagePart: 2 repeat: true.
					args addLast: parseNode].
			(Symbol hasInterned: selector contents ifTrue: [ :sym | selector _ sym])
				ifFalse: [ selector _ self correctSelector: selector contents
										wordIntervals: words
										exprInterval: (start to: self endOfLastToken)
										ifAbort: [ ^ self fail ] ].
			precedence _ 3]
		ifFalse: [((hereType == #binary or: [hereType == #verticalBar])
				and: [level >= 2])
				ifTrue: 
					[start _ self startOfNextToken.
					selector _ self advance asSymbol.
					self primaryExpression ifFalse: [^self expected: 'Argument'].
					self messagePart: 1 repeat: true.
					args _ Array with: parseNode.
					precedence _ 2]
				ifFalse: [(hereType == #word or:[hereType == #positionalMessage])
						ifTrue: 
							[start _ self startOfNextToken.
							type := hereType.
							selector _ self advance.
							type == #word ifTrue:[
								args _ #().
							] ifFalse:[
								args := self positionalArgs.
								selector := selector,'/', args size printString.
							].

							words _ OrderedCollection with: (start  + requestorOffset to: self endOfLastToken + requestorOffset).
							(Symbol hasInterned: selector ifTrue: [ :sym | selector _ sym])
								ifFalse: [ selector _ self correctSelector: selector
													wordIntervals: words
													exprInterval: (start to: self endOfLastToken)
													ifAbort: [ ^ self fail ] ].
							precedence _ 1]
						ifFalse: [^args notNil]]].
	parseNode _ MessageNode new
				receiver: receiver
				selector: selector
				arguments: args
				precedence: precedence
				from: encoder
				sourceRange: (start to: self endOfLastToken).
	repeat]
		whileTrue: [].
	^true! !

!Parser methodsFor: 'expression types' stamp: 'ar 12/4/2003 18:33'!
pattern: fromDoit inContext: ctxt 
	" unarySelector | binarySelector arg | keyword arg {keyword arg} =>  
	{selector, arguments, precedence}."
	| args selector |
	doitFlag _ fromDoit.
	fromDoit ifTrue:
			[ctxt == nil
				ifTrue: [^ {#DoIt. {}. 1}]
				ifFalse: [^ {#DoItIn:. {encoder encodeVariable: 'homeContext'}. 3}]].

	hereType == #word ifTrue: [^ {self advance asSymbol. {}. 1}].

	(hereType == #binary or: [hereType == #verticalBar])
		ifTrue: 
			[selector _ self advance asSymbol.
			args _ Array with: (encoder bindArg: self argumentName).
			^ {selector. args. 2}].

	hereType == #keyword
		ifTrue: 
			[selector _ WriteStream on: (String new: 32).
			args _ OrderedCollection new.
			[hereType == #keyword] whileTrue:[
				selector nextPutAll: self advance.
				args addLast: (encoder bindArg: self argumentName).
			].
			^ {selector contents asSymbol. args. 3}].
	hereType == #positionalMessage ifTrue:[
		args _ OrderedCollection new.
		selector := self advance.
		hereType == #rightParenthesis ifTrue:[self advance. ^{(selector,'/0') asSymbol. args. 1}].
		[
			args addLast: (encoder bindArg: self argumentName).
			hereType == #rightParenthesis ifTrue:[
				self advance. 
				selector := (selector,'/', args size printString) asSymbol.
				^{selector. args. 1}].
			here == #, ifFalse:[self expected: 'comma'].
			self advance.
		] repeat.
	].
	^ self expected: 'Message pattern'! !

!Parser methodsFor: '*PositionalMessage' stamp: 'ar 12/4/2003 18:36'!
positionalArgs
	"Parse a series of positional arguments, separated by comma."
	| args |
	(hereType == #rightParenthesis) ifTrue:[self advance. ^#()].
	args := WriteStream on: (Array new: 3).
	[
		self positionalArgsExpression ifFalse:[^self expected: 'argument'].
		args nextPut: parseNode.
		hereType == #rightParenthesis ifTrue:[self advance. ^args contents].
		here == #, ifFalse:[^self expected: 'comma'].
		self advance.
	] repeat.
! !

!Parser methodsFor: '*PositionalMessage' stamp: 'ar 12/3/2003 19:09'!
positionalArgsExpression
	"Just like #expression just keep track of commas"
	(hereType == #word and: [tokenType == #leftArrow])
		ifTrue: [^ self assignment: self variable].
	hereType == #leftBrace
		ifTrue: [self braceExpression]
		ifFalse: [self primaryExpression ifFalse: [^ false]].
	(here == #, or:[hereType == #rightParenthesis]) ifTrue:[^true].
	^self positionalMessagePart: 3 repeat: true! !

!Parser methodsFor: '*PositionalMessage' stamp: 'ar 12/3/2003 19:27'!
positionalMessagePart: level repeat: repeat
	"Just like #messagePart but keep track of comma"
	| start receiver selector args precedence words keywordStart type |
	[receiver _ parseNode.
	(hereType == #keyword and: [level >= 3])
		ifTrue: 
			[start _ self startOfNextToken.
			selector _ WriteStream on: (String new: 32).
			args _ OrderedCollection new.
			words _ OrderedCollection new.
			[hereType == #keyword]
				whileTrue: 
					[keywordStart _ self startOfNextToken + requestorOffset.
					selector nextPutAll: self advance.
					words addLast: (keywordStart to: self endOfLastToken + requestorOffset).
					self primaryExpression ifFalse: [^self expected: 'Argument'].
					self messagePart: 2 repeat: true.
					args addLast: parseNode].
			(Symbol hasInterned: selector contents ifTrue: [ :sym | selector _ sym])
				ifFalse: [ selector _ self correctSelector: selector contents
										wordIntervals: words
										exprInterval: (start to: self endOfLastToken)
										ifAbort: [ ^ self fail ] ].
			precedence _ 3]
		ifFalse: [((hereType == #binary or: [hereType == #verticalBar])
				and: [level >= 2 and:[here ~= #,]])
				ifTrue: 
					[start _ self startOfNextToken.
					selector _ self advance asSymbol.
					self primaryExpression ifFalse: [^self expected: 'Argument'].
					self messagePart: 1 repeat: true.
					args _ Array with: parseNode.
					precedence _ 2]
				ifFalse: [(hereType == #word or:[hereType == #positionalMessage])
						ifTrue: 
							[start _ self startOfNextToken.
							type := hereType.
							selector _ self advance.
							type == #word ifTrue:[
								args _ #().
							] ifFalse:[
								args := self positionalArgs.
								selector := selector,'/', args size printString.
							].
							words _ OrderedCollection with: (start  + requestorOffset to: self endOfLastToken + requestorOffset).
							(Symbol hasInterned: selector ifTrue: [ :sym | selector _ sym])
								ifFalse: [ selector _ self correctSelector: selector
													wordIntervals: words
													exprInterval: (start to: self endOfLastToken)
													ifAbort: [ ^ self fail ] ].
							precedence _ 1]
						ifFalse: [^args notNil]]].
	parseNode _ MessageNode new
				receiver: receiver
				selector: selector
				arguments: args
				precedence: precedence
				from: encoder
				sourceRange: (start to: self endOfLastToken).
	repeat]
		whileTrue: [].
	^true! !


!String methodsFor: 'converting' stamp: 'ar 12/3/2003 19:21'!
keywords
	"Answer an array of the keywords that compose the receiver."
	| kwd char keywords positionalIndex |
	"Hack this for positional messages"
	positionalIndex := self findString: '()/'.
	positionalIndex > 0 ifTrue:[^Array with: (self copyFrom: 1 to: positionalIndex-1)].
	keywords _ Array streamContents:
		[:kwds | kwd _ WriteStream on: (String new: 16).
		1 to: self size do:
			[:i |
			kwd nextPut: (char _ self at: i).
			char = $: ifTrue: 
					[kwds nextPut: kwd contents.
					kwd reset]].
		kwd isEmpty ifFalse: [kwds nextPut: kwd contents]].
	(keywords size >= 1 and: [(keywords at: 1) = ':']) ifTrue:
		["Has an initial keyword, as in #:if:then:else:"
		keywords _ keywords allButFirst].
	(keywords size >= 2 and: [(keywords at: keywords size - 1) = ':']) ifTrue:
		["Has a final keyword, as in #nextPut::andCR"
		keywords _ keywords copyReplaceFrom: keywords size - 1
								to: keywords size with: {':' , keywords last}].
	^ keywords! !

!String methodsFor: 'system primitives' stamp: 'ar 12/3/2003 19:22'!
numArgs 
	"Answer either the number of arguments that the receiver would take if considered a selector.  Answer -1 if it couldn't be a selector.  Note that currently this will answer -1 for anything begining with an uppercase letter even though the system will accept such symbols as selectors.  It is intended mostly for the assistance of spelling correction."

	| firstChar numColons excess start ix positionalIndex |
	self size = 0 ifTrue: [^ -1].
	positionalIndex := self findString: '()/'.
	positionalIndex > 0 ifTrue:[^(self copyFrom: positionalIndex+3 to: self size) asInteger].
	firstChar _ self at: 1.
	(firstChar isLetter or: [firstChar = $:]) ifTrue:
		["Fast reject if any chars are non-alphanumeric"
		(self findSubstring: '~' in: self startingAt: 1 matchTable: Tokenish) > 0 ifTrue: [^ -1].
		"Fast colon count"
		numColons _ 0.  start _ 1.
		[(ix _ self findSubstring: ':' in: self startingAt: start matchTable: CaseSensitiveOrder) > 0]
			whileTrue:
				[numColons _ numColons + 1.
				start _ ix + 1].
		numColons = 0 ifTrue: [^ 0].
		firstChar = $:
			ifTrue: [excess _ 2 "Has an initial keyword, as #:if:then:else:"]
			ifFalse: [excess _ 0].
		self last = $:
			ifTrue: [^ numColons - excess]
			ifFalse: [^ numColons - excess - 1 "Has a final keywords as #nextPut::andCR"]].
	firstChar isSpecial ifTrue:
		[self size = 1 ifTrue: [^ 1].
		2 to: self size do: [:i | (self at: i) isSpecial ifFalse: [^ -1]].
		^ 1].
	^ -1.! !