[squeak-dev] Selectors with underscores: Have your cake and eat it, too...

Andreas Raab andreas.raab at gmx.de
Sat Mar 13 04:14:49 UTC 2010


Folks -

Attached my take on selectors with underscores. It basically separates 
the issue of using underscores in assignment from the issue of using 
underscores in selectors, puts this into two individual preferences, and 
allows per-class scoping while providing a system-wide default.

The possible combinations of preferences are:

* allowUnderscoreAssignments off, allowUnderscoreSelectors: off
The use of underscores is forbidden, i.e., the Croquet model.

* allowUnderscoreAssignments on, allowUnderscoreSelectors: off
The classic Squeak usage; all of the following are assignments:

	a _ b 	=>		a := b
	b_ c	=>		b := c
	d _e	=> 		d := e
	f_g	=>		f := g.

* allowUnderscoreAssignments off, allowUnderscoreSelectors: on
The standard usage in other dialects

	a _ b	=> 		((a) _) b
	b_ c	=>		(b_) c
	d _e	=>		(d) _e
	f_g	=>		(f_g)

* allowUnderscoreAssignments on, allowUnderscoreSelectors: on
The hybrid usage requiring spaces around underscore for assignment:

	a _ b	=> 		a := b
	b_ c	=>		(b_) c
	d _e	=>		(d) _e
	f_g	=>		(f_g)

This gives us a range of options to decide how to deal with it. I would 
personally say that for the core image we should go with the first 
option (disable underscores altogether) and only enable whichever option 
we like for the release.

What do people think about this approach? I think it provides the most 
options and gives us ample flexibility to decide what we'd like to use 
down the road.

If there is no fundamental opposition I'll push it into the trunk in a 
couple of days.

Cheers,
   - Andreas
-------------- next part --------------
'From Squeak3.11alpha of 10 March 2010 [latest update: #9678] on 12 March 2010 at 4:13:23 pm'!
"Change Set:		Underscores
Date:			12 March 2010
Author:			Andreas Raab

Deal with underscore as assignments and in selectors by introducing two preferences: #allowUnderscoreAssignments determines if underscores are allowed as assignments; #allowUnderscoreSelectors determines if underscores can be used in selectors or variable names. The properties can be set on a per-class basis; if the class returns nil then the system-wide defaults prevail.

The possible combinations are:
* allowUnderscoreAssignments off, allowUnderscoreSelectors: off
The use of underscores is forbidden, i.e., the Croquet model.

* allowUnderscoreAssignments on, allowUnderscoreSelectors: off
The classic Squeak usage; all of the following are assignments:
	a _ b 	=>		a := b
	b_ c	=>		b := c
	d _e	=> 		d := e
	f_g		=>		f := g.

* allowUnderscoreAssignments off, allowUnderscoreSelectors: on
The standard usage in other dialects
	a _ b	=> 		((a) _) b
	b_ c	=>		(b_) c
	d _e	=>		(d) _e
	f_g		=>		(f_g)

* allowUnderscoreAssignments on, allowUnderscoreSelectors: on
The hybrid usage requiring spaces around underscore for assignment:

	a _ b	=> 		a := b
	b_ c	=>		(b_) c
	d _e	=>		(d) _e
	f_g		=>		(f_g)

"!

Object subclass: #Scanner
	instanceVariableNames: 'source mark hereChar aheadChar token tokenType currentComment buffer typeTable'
	classVariableNames: 'AllowUnderscoreAssignments AllowUnderscoreSelectors TypeTable'
	poolDictionaries: ''
	category: 'Compiler-Kernel'!

!Behavior methodsFor: 'compiling' stamp: 'ar 3/12/2010 15:50'!
allowUnderscoreAssignments
	"Return true if the receiver and its subclasses should be allowed to use underscore as assignment operator. Returning nil here means that the compiler should use the system-wide default preference. Also see #allowUnderscoreSelectors.

	Combinations: If both preferences are false, underscore is illegal. If both preferences are true, underscore assignment needs the be surrounded by spaces and a single underscore cannot be used as selector."
	^nil! !

!Behavior methodsFor: 'compiling' stamp: 'ar 3/12/2010 13:05'!
allowUnderscoreSelectors
	"Return true if the receiver and its subclasses should be allowed to use underscore in selectors. Returning nil here means that the compiler should use the system-wide default preference. Also see #allowUnderscoreAssignments.

	Combinations: If both preferences are false, underscore is illegal. If both preferences are true, underscore assignment needs the be surrounded by spaces and a single underscore cannot be used as selector."
	^nil! !


!Scanner methodsFor: 'multi-character scans' stamp: 'ar 3/12/2010 15:52'!
xLetter
	"Form a word or keyword."

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

!Scanner methodsFor: 'multi-character scans' stamp: 'ar 3/12/2010 16:10'!
xUnderscore
	self allowUnderscoreAssignments ifTrue:[ | type |
		"Figure out if x _foo (no space between _ and foo) 
		should be a selector or assignment"
		(((type := self typeTableAt: aheadChar) == #xLetter
			or:[type == #xDigit or:[type == #xUnderscore]]) 
			and:[self allowUnderscoreSelectors]) ifFalse:[
				self step.
				tokenType := #leftArrow.
				^token := #':='
		].
	].
	self allowUnderscoreSelectors ifTrue:[^self xLetter].
	^self xIllegal
! !

!Scanner methodsFor: 'private' stamp: 'ar 3/12/2010 15:51'!
allowUnderscoreAssignments
	"Query preference"
	^self class prefAllowUnderscoreAssignments! !

!Scanner methodsFor: 'private' stamp: 'ar 3/12/2010 15:51'!
allowUnderscoreSelectors
	"Query preference"
	^self class prefAllowUnderscoreSelectors! !


!Parser methodsFor: 'private' stamp: 'ar 3/12/2010 16:10'!
allowUnderscoreAssignments
	"Query class + preference"
	^encoder classEncoding allowUnderscoreAssignments
		ifNil:[super allowUnderscoreAssignments]! !

!Parser methodsFor: 'private' stamp: 'ar 3/12/2010 15:55'!
allowUnderscoreSelectors
	"Query class + preference"
	^encoder classEncoding allowUnderscoreSelectors
		ifNil:[super allowUnderscoreSelectors]! !


!Scanner class methodsFor: 'initialization' stamp: 'ar 3/12/2010 15:55'!
initialize
	| newTable |
	newTable := Array new: 256 withAll: #xBinary. "default"
	newTable atAll: #(9 10 12 13 32 ) put: #xDelimiter. "tab lf ff cr space"
	newTable atAll: ($0 asciiValue to: $9 asciiValue) put: #xDigit.

	1 to: 255
		do: [:index |
			(Character value: index) isLetter
				ifTrue: [newTable at: index put: #xLetter]].

	newTable at: 30 put: #doIt.
	newTable at: $" asciiValue put: #xDoubleQuote.
	newTable at: $# asciiValue put: #xLitQuote.
	newTable at: $$ asciiValue put: #xDollar.
	newTable at: $' asciiValue put: #xSingleQuote.
	newTable at: $: asciiValue put: #xColon.
	newTable at: $( asciiValue put: #leftParenthesis.
	newTable at: $) asciiValue put: #rightParenthesis.
	newTable at: $. asciiValue put: #period.
	newTable at: $; asciiValue put: #semicolon.
	newTable at: $[ asciiValue put: #leftBracket.
	newTable at: $] asciiValue put: #rightBracket.
	newTable at: ${ asciiValue put: #leftBrace.
	newTable at: $} asciiValue put: #rightBrace.
	newTable at: $^ asciiValue put: #upArrow.
	newTable at: $_ asciiValue put: #xUnderscore.
	newTable at: $| asciiValue put: #verticalBar.
	TypeTable := newTable "bon voyage!!"

	"Scanner initialize"! !

!Scanner class methodsFor: 'preferences' stamp: 'ar 3/12/2010 15:50'!
prefAllowUnderscoreAssignments
	"Accessor for the system-wide preference"
	<preference: 'Allow underscore assignments'
		category: 'Compiler'
		description: 'When true, underscore can be used as assignment operator'
		type: #Boolean>
	^AllowUnderscoreAssignments ifNil:[false]! !

!Scanner class methodsFor: 'preferences' stamp: 'ar 3/12/2010 15:50'!
prefAllowUnderscoreAssignments: aBool
	"Accessor for the system-wide preference"
	AllowUnderscoreAssignments := aBool! !

!Scanner class methodsFor: 'preferences' stamp: 'ar 3/12/2010 15:50'!
prefAllowUnderscoreSelectors
	"Accessor for the system-wide preference"
	<preference: 'Allow underscore selectors'
		category: 'Compiler'
		description: 'When true, underscore can be used in selectors and varibable names'
		type: #Boolean>
	^AllowUnderscoreSelectors ifNil:[false]! !

!Scanner class methodsFor: 'preferences' stamp: 'ar 3/12/2010 15:50'!
prefAllowUnderscoreSelectors: aBool
	"Accessor for the system-wide preference"
	AllowUnderscoreSelectors := aBool! !

Scanner initialize!


More information about the Squeak-dev mailing list