Class comments (was Re: ProtoObject?)

Dan Ingalls Dan.Ingalls at disney.com
Fri Feb 11 04:30:17 UTC 2000


"Vassili Bykov" <vassili at objectpeople.com> wrote...
>We can pre-fill the template with variable names at least (see attached)

Yes, this is what I had in mind, only a bit more. 
The attached changeSet will produce templates such as the following (for TMethod)...

--------------------
This class NEEDS a comment along the following lines...
Main comment stating the purpose of this class and relevant relationship to other classes.

Possible useful expressions for doIt or printIt.

sub-structure...
selector		String -- comment about selector
returnType		String -- comment about returnType
args		SequenceableCollection -- comment about args
locals		OrderedCollection -- comment about locals
declarations		Dictionary -- comment about declarations
primitive		Object -- comment about primitive
parseTree		TStmtListNode -- comment about parseTree
labels		OrderedCollection -- comment about labels
possibleSideEffectsCache		Boolean -- comment about possibleSideEffectsCache
complete		Boolean -- comment about complete
export		Boolean -- comment about export

Any further useful comments about the general approach of this implementation.
--------------------

Here's the preamble for these changes......
Defines a message ClassDescription>>likelyTypes that is implemented by cheap type inference.
What is cheap type inference?  It is the merger of two sources of information...

First, patterns of the form
	instVar _ SomeClass new (or new: size)
are taken to be indicative of the type of that variable.

Second, a tally is made of all messages sent directly to instance variables.  This signature is then used to determine what possible classes might properly respond to all those messages.  Often this results in many possible classes.  In these cases, we choose a subclass of Magnitude or the class of which there are the most subclasses in the system.

In addition this changeSet uses the above methods to build a sample type table as part of a template for classes that have not yet been commented.

Here are a number of examples of the results produced by these 6 pages of code...
----------------------
Point typeTemplate
x		Integer -- comment about x
y		Integer -- comment about y

Rectangle typeTemplate
origin		Point -- comment about origin
corner		Point -- comment about corner

Text typeTemplate
string		String -- comment about string
runs		RunArray -- comment about runs

RunArray typeTemplate
runs		OrderedCollection -- comment about runs
values		OrderedCollection -- comment about values
lastIndex		Object -- comment about lastIndex
lastRun		Object -- comment about lastRun
lastOffset		Number -- comment about lastOffset

Paragraph typeTemplate
clippingRectangle		Rectangle -- comment about clippingRectangle
compositionRectangle		Rectangle -- comment about compositionRectangle
destinationForm		Form -- comment about destinationForm
rule		Object -- comment about rule
mask		Object -- comment about mask
marginTabsLevel		Integer -- comment about marginTabsLevel
lines		Array -- comment about lines
lastLine		Integer -- comment about lastLine

TextStyle typeTemplate
fontArray		SequenceableCollection -- comment about fontArray
fontFamilySize		Object -- comment about fontFamilySize
lineGrid		Object -- comment about lineGrid
baseline		Object -- comment about baseline
alignment		Integer -- comment about alignment
firstIndent		Integer -- comment about firstIndent
restIndent		Integer -- comment about restIndent
rightIndent		Integer -- comment about rightIndent
tabsArray		Object -- comment about tabsArray
marginTabsArray		Object -- comment about marginTabsArray
leading		Object -- comment about leading
defaultFontIndex		Integer -- comment about defaultFontIndex

StrikeFont typeTemplate
xTable		SequenceableCollection -- comment about xTable
glyphs		Form -- comment about glyphs
name		SequenceableCollection -- comment about name
stopConditions		Array -- comment about stopConditions
type		Integer -- comment about type
minAscii		SmallInteger -- comment about minAscii
maxAscii		Integer -- comment about maxAscii
maxWidth		SmallInteger -- comment about maxWidth
strikeLength		Number -- comment about strikeLength
ascent		SmallInteger -- comment about ascent
descent		SmallInteger -- comment about descent
xOffset		Integer -- comment about xOffset
raster		Number -- comment about raster
subscript		Object -- comment about subscript
superscript		Object -- comment about superscript
emphasis		Integer -- comment about emphasis
derivativeFonts		Array -- comment about derivativeFonts
pointSize		SmallInteger -- comment about pointSize

If you have read this far, you may wonder why I am doing this.
The reason is that somewhere out there someone is saying
"... but I can do much better than this..."

	;-)
-------------- next part --------------
'From Squeak2.8alpha of 12 January 2000 [latest update: #1851] on 10 February 2000 at 8:14:26 pm'!
"Change Set:		CheapTypes
Date:			9 February 2000
Author:			Dan Ingalls

Defines a message ClassDescription>>likelyTypes that is implemented by cheap type inference.  What is cheap type inference?  It is the merger of two sources of information...

First, patterns of the form
	instVar _ SomeClass new (or new: size)
are taken to be indicative of the type of that variable.

Second, a tally is made of all messages sent directly to instance variables.  This signature is then used to determine what possible classes might properly respond to all those messages.  Often this results in many possible classes.  Choose a subclass of Magnitude or the one of which there are the most subclasses in the system.

In addition this changeSet uses the above methods to build a sample type table as part of a template for classes that have not yet been commented.
"!


!ClassDescription methodsFor: 'accessing' stamp: 'di 2/10/2000 20:05'!
comment
	"Answer the receiver's comment. (If old format, not a Text, unpack the old way.) "

	| aString cr |
	aString _ self theNonMetaClass organization classComment.
	aString isEmpty ifFalse: [^ aString].
	cr _ Character cr asString.
^
'This class NEEDS a comment along the following lines...
Main comment stating the purpose of this class and relevant relationship to other classes.

Possible useful expressions for doIt or printIt.
' , (self instVarNames isEmpty
		ifTrue: ['']
		ifFalse: [cr , 'sub-structure...' , cr , self typeTemplate]) , '
Any further useful comments about the general approach of this implementation.
'! !

!ClassDescription methodsFor: 'accessing' stamp: 'di 2/10/2000 19:56'!
typeTemplate
	"Answer a String summarizing the likely types for this class."

	| types names |
	^ String streamContents:
			[:strm | types _ self likelyTypes.
			names _ self allInstVarNames.
			(superclass == nil ifTrue: [1] ifFalse: [superclass instSize+1])
				to: self instSize do:
				[:i | strm nextPutAll: (names at: i);
						tab; tab; print: (types at: i);
						nextPutAll: ' -- comment about ' , (names at: i); cr]]! !

!ClassDescription methodsFor: 'accessing class hierarchy' stamp: 'di 2/9/2000 15:34'!
classesThatImplementAllOf: selectorSet
	"Return an array of any classes that implement all the messages in selectorSet."

	| found remaining |
	found _ OrderedCollection new.
	selectorSet do:
		[:sel | (methodDict includesKey: sel) ifTrue: [found add: sel]].
	found isEmpty
		ifTrue: [^ self subclasses inject: Array new
						into: [:subsThatDo :sub |
							subsThatDo , (sub classesThatImplementAllOf: selectorSet)]]
		ifFalse: [remaining _ selectorSet copyWithoutAll: found.
				remaining isEmpty ifTrue: [^ Array with: self].
				^ self subclasses inject: Array new
						into: [:subsThatDo :sub |
							subsThatDo , (sub classesThatImplementAllOf: remaining)]]! !

!ClassDescription methodsFor: 'accessing class hierarchy' stamp: 'di 2/10/2000 16:54'!
inittedTypes
	"Return the initted type of each instance variable.
	This result is represented as an array parallel to self allInstVarNames,
	with each element nil or a class."

	| inittedTypes method parseNode |
	inittedTypes _ Array new: self instSize.
	self selectors do:
		[:selector |
		method _ self compiledMethodAt: selector.
		parseNode _ self compilerClass new
					compile: (method getSourceFor: selector in: self)
					in: self notifying: nil ifFail: [].
		parseNode noteInittedTypes: inittedTypes].
	^ inittedTypes
! !

!ClassDescription methodsFor: 'accessing class hierarchy' stamp: 'di 2/10/2000 19:52'!
likelyTypes
	"Return the likely types of each instance variable.
	This result is represented as an array parallel to self allInstVarNames,
	with each element being an array of classes -- a union of concrete types."

	| selectorsSent method parseNode types inittedTypes inferredTypes |
	selectorsSent _ (1 to: self instSize) collect: [:instVarOffset | Set new].
	self selectors do:
		[:selector |
		method _ self compiledMethodAt: selector.
		parseNode _ self compilerClass new
					compile: (method getSourceFor: selector in: self)
					in: self notifying: nil ifFail: [].
		parseNode tallySendsToInstVarsInto: selectorsSent].
	selectorsSent _ selectorsSent collect: [:selSet | selSet asOrderedCollection].
	inferredTypes _ selectorsSent collect:
					[:selSet | ProtoObject classesThatImplementAllOf: selSet].
	inittedTypes _ self inittedTypes.

"true ifTrue: [^ inferredTypes]."

	^ (1 to: self instSize) collect:
		[:i | (inittedTypes at: i)
			ifNil: [types _ inferredTypes at: i.
				(types isEmpty or: [types = {ProtoObject}])
					ifTrue: [Object]
					ifFalse: [types detect: [:cl | cl inheritsFrom: Magnitude]
								ifNone: [types detectMax: [:cl | cl allSubclasses size]]]]]
! !


!ParseNode methodsFor: 'testing' stamp: 'di 2/9/2000 11:11'!
isInstVar

	^ false! !

!ParseNode methodsFor: 'converting' stamp: 'di 2/10/2000 12:10'!
noteInittedTypes: arrayOfTypes
	"Overridden by MessageNode"! !

!ParseNode methodsFor: 'converting' stamp: 'di 2/9/2000 10:48'!
tallySendsToInstVarsInto: arrayOfSelectorSets
	"Overridden by MessageNode"! !


!AssignmentNode methodsFor: 'testing' stamp: 'di 2/10/2000 17:56'!
noteInittedTypes: arrayOfTypes

	| type valueNode |
	variable isInstVar ifFalse: [^ value noteInittedTypes: arrayOfTypes].

	value isSpecialConstant
		ifTrue:
		[" instVar _ true, false, -1, 0 1 2 "
		value code = LdTrue ifTrue: [type _ Boolean].
		value code = LdFalse ifTrue: [type _ Boolean].
		value code >= LdMinus1 ifTrue: [type _ Integer]]
		ifFalse:
		[(value isMemberOf: LiteralNode) ifTrue:
			[" instVar _ literalConstant "
			type _ value literalValue class]].

	(value isMemberOf: CascadeNode)
		ifTrue: [valueNode _ value receiver]
		ifFalse: [valueNode _ value].
	((valueNode isMessage: #new
		receiver: [:rcvr | rcvr isVariableReference and: [rcvr type = LdLitIndType]]
		arguments: nil)
	or:
	[valueNode isMessage: #new:
		receiver: [:rcvr | rcvr isVariableReference and: [rcvr type = LdLitIndType]]
		arguments: nil])
	ifTrue:
		[" instVar _ SomeClass new  or  AnotherClass new: "		
		Smalltalk at: valueNode receiver key key
			ifPresent: [:cl | (cl isKindOf: Behavior) ifTrue: [type _ cl]]].

	type ifNotNil:
		["If any of above were successful, install the type."
		arrayOfTypes at: variable fieldOffset + 1 put: type].

	value noteInittedTypes: arrayOfTypes
! !

!AssignmentNode methodsFor: 'testing' stamp: 'di 2/9/2000 10:58'!
tallySendsToInstVarsInto: arrayOfSelectorSets

	value tallySendsToInstVarsInto: arrayOfSelectorSets
! !


!BlockNode methodsFor: 'testing' stamp: 'di 2/10/2000 12:08'!
noteInittedTypes: arrayOfTypes

	statements do: [:stmt | stmt noteInittedTypes: arrayOfTypes]
! !

!BlockNode methodsFor: 'testing' stamp: 'di 2/9/2000 10:57'!
tallySendsToInstVarsInto: arrayOfSelectorSets

	statements do: [:stmt | stmt tallySendsToInstVarsInto: arrayOfSelectorSets]
! !


!BraceNode methodsFor: 'testing' stamp: 'di 2/10/2000 12:09'!
noteInittedTypes: arrayOfTypes

	elements do: [:stmt | stmt noteInittedTypes: arrayOfTypes]
! !

!BraceNode methodsFor: 'testing' stamp: 'di 2/9/2000 10:58'!
tallySendsToInstVarsInto: arrayOfSelectorSets

	elements do: [:stmt | stmt tallySendsToInstVarsInto: arrayOfSelectorSets]
! !


!CascadeNode methodsFor: 'initialize-release' stamp: 'di 2/10/2000 16:59'!
receiver
	^ receiver! !

!CascadeNode methodsFor: 'testing' stamp: 'di 2/10/2000 12:11'!
noteInittedTypes: arrayOfTypes

	receiver noteInittedTypes: arrayOfTypes.
	messages do:
		[:msg | msg arguments do:
			[:arg | arg noteInittedTypes: arrayOfTypes]]! !

!CascadeNode methodsFor: 'testing' stamp: 'di 2/10/2000 11:08'!
tallySendsToInstVarsInto: arrayOfSelectorSets

	receiver isInstVar
		ifTrue: [messages do:
					[:msg | (arrayOfSelectorSets at: receiver fieldOffset + 1)
								add: msg selector key]]
		ifFalse: [receiver tallySendsToInstVarsInto: arrayOfSelectorSets].
	messages do:
		[:msg | msg arguments do:
			[:arg | arg tallySendsToInstVarsInto: arrayOfSelectorSets]]! !


!MessageNode methodsFor: 'testing' stamp: 'di 2/10/2000 12:09'!
noteInittedTypes: arrayOfTypes

	receiver noteInittedTypes: arrayOfTypes.
	arguments do:
		[:arg | arg ifNotNil: [arg noteInittedTypes: arrayOfTypes]]! !

!MessageNode methodsFor: 'testing' stamp: 'di 2/10/2000 11:50'!
tallySendsToInstVarsInto: arrayOfSelectorSets

	receiver isInstVar
		ifTrue: [(arrayOfSelectorSets at: receiver fieldOffset + 1) add: selector key]
		ifFalse: [receiver tallySendsToInstVarsInto: arrayOfSelectorSets].
	arguments do:
		[:arg | arg ifNotNil: [arg tallySendsToInstVarsInto: arrayOfSelectorSets]]! !


!MethodNode methodsFor: 'testing' stamp: 'di 2/10/2000 12:07'!
noteInittedTypes: arrayOfTypes

	block noteInittedTypes: arrayOfTypes
! !

!MethodNode methodsFor: 'testing' stamp: 'di 2/9/2000 10:57'!
tallySendsToInstVarsInto: arrayOfSelectorSets

	block tallySendsToInstVarsInto: arrayOfSelectorSets
! !


!ReturnNode methodsFor: 'testing' stamp: 'di 2/10/2000 12:10'!
noteInittedTypes: arrayOfTypes

	expr noteInittedTypes: arrayOfTypes
! !

!ReturnNode methodsFor: 'testing' stamp: 'di 2/9/2000 11:56'!
tallySendsToInstVarsInto: arrayOfSelectorSets

	expr tallySendsToInstVarsInto: arrayOfSelectorSets
! !


!VariableNode methodsFor: 'testing' stamp: 'di 2/9/2000 11:11'!
isInstVar

	^ self type = LdInstType! !

!VariableNode methodsFor: 'testing' stamp: 'di 2/10/2000 17:16'!
isSpecialConstant
	^ code between: LdTrue and: LdMinus1+3! !

!VariableNode methodsFor: 'testing' stamp: 'di 2/10/2000 17:03'!
name
	^ name! !


ClassDescription removeSelector: #messagesSentToInstvars!
ClassDescription removeSelector: #inittedType!


More information about the Squeak-dev mailing list