On Wed, 17 Sep 2003, Richard A. O'Keefe wrote:

> "Andreas Raab" <andreas.raab at gmx.de> wrote:
> 	+initializeWithFoo: aFoo bar: aBar
> 	could simply compile a class-side method which is
> Yes.  YES.  **YES**!   Let's DO it!

A quick and dirty hack that hasn't been tested much.  Don't file it into a
mission-critical image.

Ian
-------------- next part --------------
'From Squeak3.6beta of ''4 July 2003'' [latest update: #5411] on 17 September 2003 at 8:19:31 am'!
"Change Set:		AutoClassInitialiser-ikp
Date:			17 September 2003
Author:			Ian Piumarta

Modifies the compiler to generate class-side instance creation messages corresponding to instance-side initialisation methods whose pattern begins with '+'.  Note that it only works with unary and keyword selectors, that it refuses to generate the instance creation method for class-side initialiser patterns, that the '+' must be the first character in the text being compiled, and that the unary or keyword pattern must follow the '+' without intervening whitespace.  Note also that it hasn't been tested much.  Caveat adopter."!

ParseNode subclass: #MethodNode
	instanceVariableNames: 'selectorOrFalse precedence arguments block literals primitive encoder temporaries sourceText initFlag '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Compiler'!
Scanner subclass: #Parser
	instanceVariableNames: 'here hereType hereMark hereEnd prevMark prevEnd encoder requestor parseNode failBlock requestorOffset tempsMark doitFlag initFlag '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Compiler'!

!CodeHolder methodsFor: 'message list' stamp: 'ikp 9/17/2003 08:07'!
validateMessageSource: sourceString forSelector: aSelector
	"Check whether there is evidence that method source is invalid"

	| sourcesName |
	(self selectedClass compilerClass == Object compilerClass
			and: [(sourceString first ~~ $+)
			and: [(sourceString asString findString: aSelector keywords first ) ~= 1]])
		ifTrue: [sourcesName _ FileDirectory localNameFor: Smalltalk sourcesName.
			self inform: 'There may be a problem with your sources file!!

The source code for every method should (usually) start with the
method selector but this is not the case with this method!! You may
proceed with caution but it is recommended that you get a new source file.

This can happen if you download the "' , sourcesName  , '" file, 
or the ".changes" file you use, as TEXT. It must be transfered 
in BINARY mode, even if it looks like a text file, 
to preserve the CR line ends.

Mac users: This may have been caused by Stuffit Expander. 
To prevent the files above to be converted to Mac line ends 
when they are expanded, do this: Start the program, then 
from Preferences... in the File menu, choose the Cross 
Platform panel, then select "Never" and press OK. 
Then expand the compressed archive again.

(Occasionally, the source code for a method may legitimately
start with a non-alphabetic character -- for example, Behavior
method #formalHeaderPartsFor:.  In such rare cases, you can
happily disregard this warning.)'].! !


!MethodNode methodsFor: 'initialize-release' stamp: 'ikp 9/17/2003 07:03'!
initFlag: aBool

	initFlag _ aBool! !

!MethodNode methodsFor: 'code generation' stamp: 'ikp 9/17/2003 08:15'!
generate: trailer 
	"The receiver is the root of a parse tree. Answer a CompiledMethod. The
	argument, trailer, is the references to the source code that is stored with 
	every CompiledMethod."

	| blkSize nLits stack strm nArgs method |
	self generate: trailer ifQuick: 
		[:m |  method _ m.
		method cacheTempNames: self tempNames.
		^ method].
	nArgs _ arguments size.
	blkSize _ block sizeForEvaluatedValue: encoder.
	literals _ encoder allLiterals.
	(nLits _ literals size) > 255
		ifTrue: [^self error: 'Too many literals referenced'].
	method _ CompiledMethod	"Dummy to allocate right size"
				newBytes: blkSize
				trailerBytes: trailer 
				nArgs: nArgs
				nTemps: encoder maxTemp
				nStack: 0
				nLits: nLits
				primitive: primitive.
	strm _ ReadWriteStream with: method.
	strm position: method initialPC - 1.
	stack _ ParseStack new init.
	block emitForEvaluatedValue: stack on: strm.
	stack position ~= 1 ifTrue: [^self error: 'Compiler stack
discrepancy'].
	strm position ~= (method size - trailer size) 
		ifTrue: [^self error: 'Compiler code size discrepancy'].
	method needsFrameSize: stack size.
	1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
	method cacheTempNames: self tempNames.
	"Careful: when recompiling during file-in the flag can be nil"
	initFlag == true ifTrue: [self generateInitializer].
	^ method! !

!MethodNode methodsFor: 'code generation' stamp: 'ikp 9/17/2003 08:19'!
generateInitializer

	| keywords args init |
	encoder classEncoding isMeta ifTrue: [^self].
	keywords _ self selector keywords.
	args _ arguments collect: [:argNode | argNode name].
	(args isEmpty not and: [keywords size ~~ args size]) ifTrue: [^self].
	(args isEmpty and: [keywords size ~~ 1]) ifTrue: [^self].
	args _ args collect: [:arg | arg , 'Initializer'].
	init _ String streamContents:
		[:s |
		args isEmpty
			ifTrue: [s nextPutAll: keywords first]
			ifFalse:
				[keywords with: args do: [:key :arg |
					s nextPutAll: key; space; nextPutAll: arg; space]].
		s cr; tab; nextPutAll: '"This method was generated automatically from the instance method'.
		s cr; tab; nextPutAll: '+'; nextPutAll: self selector.
		s cr; tab; nextPutAll: 'and will be replaced *every* time that method is modified!!"'; cr.
		s cr; tab; nextPutAll: '^super new'.
		args isEmpty
			ifTrue: [s space; nextPutAll: keywords first]
			ifFalse:
				[keywords with: args do: [:key :arg |
					s cr; tab; tab; nextPutAll: key; space; nextPutAll: arg]]].
	encoder classEncoding class
		compile: init
		classified: 'instance creation'
		notifying: nil! !


!Scanner methodsFor: 'multi-character scans' stamp: 'ikp 9/17/2003 07:48'!
xBinary

	tokenType _ #binary.
	(hereChar == $+ and: [source position == 2 and: [aheadChar isLetter]])
		ifTrue:
			[self step; xLetter.
			tokenType _ tokenType == #word
				ifTrue: [#initWord]
				ifFalse: [#initKeyword].
			^self].
	token _ self step asSymbol.
	[(typeTable at: hereChar asciiValue) = #xBinary and: [hereChar ~= $-]]
		whileTrue: [token _ (token , (String with: self step)) asSymbol]! !


!Parser methodsFor: 'expression types' stamp: 'ikp 9/17/2003 07:04'!
method: doit context: ctxt encoder: encoderToUse
	" pattern [ | temporaries ] block => MethodNode."

	| sap blk prim temps messageComment methodNode |
	encoder _ encoderToUse.
	sap _ self pattern: doit inContext: ctxt.
	"sap={selector, arguments, precedence}"
	(sap at: 2) do: [:argNode | argNode isArg: true].
	temps _ self temporaries.
	messageComment _ currentComment.
	currentComment _ nil.
	prim _ doit ifTrue: [0] ifFalse: [self primitive].
	self statements: #() innerBlock: doit.
	blk _ parseNode.
	doit ifTrue: [blk returnLast]
		ifFalse: [blk returnSelfIfNoOther].
	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;
		initFlag: initFlag! !

!Parser methodsFor: 'expression types' stamp: 'ikp 9/17/2003 08:02'!
pattern: fromDoit inContext: ctxt 
	" unarySelector | binarySelector arg | keyword arg {keyword arg} =>  
	{selector, arguments, precedence}."
	| args selector |
	doitFlag _ fromDoit.
	initFlag _ false.
	fromDoit ifTrue:
			[ctxt == nil
				ifTrue: [^ {#DoIt. {}. 1}]
				ifFalse: [^ {#DoItIn:. {encoder encodeVariable: 'homeContext'}. 3}]].

	hereType == #initWord
		ifTrue:
			[initFlag _ true.
			hereType _ #word].
	hereType == #initKeyword
		ifTrue:
			[initFlag _ true.
			hereType _ #keyword].

	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}].

	^ self expected: 'Message pattern'! !