'From Cuis 1.0 of 6 April 2009 [latest update: #169] on 7 April 2009 at 4:24:45 pm'!

!ChangeSorter class methodsFor: 'services' stamp: 'jmv 4/7/2009 16:02'!
changeSetCategoryClass
	"This method is only to hold a reference to the class,
	as it could be removed by shrinking tools otherwise"
	^ChangeSetCategory! !


!SystemDictionary methodsFor: 'retrieving' stamp: 'jmv 4/7/2009 15:47'!
allGlobalRefs
	"Answer a set of symbols that may be refs to Global names.
	Warning: Will not include references to a class from its own methods"

	^ self allGlobalRefsWithout: {{}. {}}! !

!SystemDictionary methodsFor: 'retrieving' stamp: 'jmv 4/7/2009 15:52'!
allGlobalRefsWithout: classesAndMessagesPair
	"Answer a set of symbols that may be refs to Global names. 
	This method computes its result in the absence of specified classes and messages.
	Does not include references from a class to itself"

	| globalRefs absentClasses absentSelectors |
	globalRefs _ IdentitySet new: CompiledMethod instanceCount.
	absentClasses _ classesAndMessagesPair first.
	absentSelectors _ classesAndMessagesPair second.
	Cursor execute showWhile: 
		[self classNames do: 
			[:cName | ((absentClasses includes: cName)
						ifTrue: [{}]
						ifFalse: [{(self at: cName). (self at: cName) class}]) do:
				[:cl | (absentSelectors isEmpty
						ifTrue: [cl selectors]
						ifFalse: [cl selectors copyWithoutAll: absentSelectors]) do: 
					[:sel | "Include all capitalized symbols for good measure"
					self allSymbolsIn: (cl compiledMethodAt: sel) literals do: 
						[:m | 
						((m isMemberOf: Symbol) and: [ m size > 0] and: [m first isUppercase]) ifTrue:
							[m = cl name ifFalse: [
								globalRefs add: m]].
						(m isVariableBinding) ifTrue:
							[m key ifNotNil: [
								m key = cl name ifFalse: [
									globalRefs add: m key]]]]]]]].
	^ globalRefs! !

!SystemDictionary methodsFor: 'retrieving' stamp: 'jmv 4/7/2009 13:30'!
allSentMessagesWithout: classesAndMessagesPair
	"Answer the set of selectors which are sent somewhere in the system, 
	computed in the absence of the supplied classes and messages."

	| sent absentClasses absentSelectors |
	sent _ IdentitySet new: CompiledMethod instanceCount.
	absentClasses _ classesAndMessagesPair first.
	absentSelectors _ classesAndMessagesPair second.
	Cursor execute showWhile: 
		[self classNames do: 
			[:cName | ((absentClasses includes: cName)
						ifTrue: [{}]
						ifFalse: [{(self at: cName). (self at: cName) class}]) do:
				[:cl | (absentSelectors isEmpty
						ifTrue: [cl selectors]
						ifFalse: [cl selectors copyWithoutAll: absentSelectors]) do: 
					[:sel | "Include all sels, but not if sent by self"
					self allSymbolsIn: (cl compiledMethodAt: sel) literals do: 
						[ :m | m == sel ifFalse: [sent add: m] ].
					]]].
		"The following may be sent without being in any literal frame"
		1 to: self specialSelectorSize do: 
			[:index | 
			sent add: (self specialSelectorAt: index)]].
	Smalltalk presumedSentMessages do: [:sel | sent add: sel].
	^ sent! !

!SystemDictionary methodsFor: 'retrieving' stamp: 'jmv 4/7/2009 15:48'!
allUnusedClassesWithout: classesAndMessagesPair
	"Enumerates all classes in the system and returns a list of those that are apparently unused. A class is considered in use if it (a) has subclasses or (b) is referred to by some method or (c) has its name in use as a literal (but not in the same class) or: (d) some instance is a global."
	"Smalltalk unusedClasses"

	| unused cl |
	Smalltalk garbageCollect.
	unused _ Smalltalk classNames asIdentitySet
				copyWithoutAll: (self allGlobalRefsWithout: classesAndMessagesPair).
				
	Smalltalk do: [ :global |
		unused remove: global class name ifAbsent: []].
	
	^ unused reject:
		[:cName | cl _ Smalltalk at: cName.
		cl subclasses notEmpty
			"or: [ cl someInstance notNil ]"
			or: [cl inheritsFrom: FileDirectory]]! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'jmv 4/7/2009 16:24'!
presumedSentMessages   | sent |
"Smalltalk presumedSentMessages"

	"The following should be preserved for doIts, etc"
	sent _ IdentitySet new.
	#( rehashWithoutBecome compactSymbolTable rebuildAllProjects
		browseAllSelect:  lastRemoval
		vScrollBarValue: hScrollBarValue: scrollBarMenuButtonPressed: 
		withSelectionFrom:  to: removeClassNamed:
		dragon: hilberts: mandala: web test3 factorial tinyBenchmarks benchFib
		newDepth: restoreAfter: forgetDoIts zapAllMethods obsoleteClasses
		removeAllUnSentMessages abandonSources removeUnreferencedKeys
		reclaimDependents zapOrganization condenseChanges browseObsoleteReferences
		subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:
		methodsFor:stamp: methodsFor:stamp:prior: instanceVariableNames:
		startTimerInterruptWatcher unusedClasses) do:
		[:sel | sent add: sel].
	"The following may be sent by perform: in dispatchOnChar..."
	(TextEditor classPool at: #CmdActions) asSet do:
		[:sel | sent add: sel].
	(TextEditor classPool at: #ShiftCmdActions) asSet do:
		[:sel | sent add: sel].
	#(beReadOnlyBinding beReadWriteBinding changeSetCategoryClass belongsInAll:) do:
		[:sel | sent add: sel].
	^ sent! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'jmv 4/7/2009 14:24'!
removedUnusedClassesAndMethods
	[
		#hereWeGo print.
		Smalltalk unusedClasses do: [:c | 
			c print.
			(Smalltalk at: c) removeFromSystem]. 
		Smalltalk removeAllUnSentMessages > 0 or: [ Smalltalk unusedClasses notEmpty ]] whileTrue.! !

!SystemDictionary methodsFor: 'shrinking' stamp: 'jmv 4/7/2009 15:52'!
unusedClasses
	"Enumerates all classes in the system and returns a list of those that are apparently unused. A class is considered in use if it (a) has subclasses or (b) is referred to by some method or (c) has its name in use as a literal (but not in the same class) or (d) some instance is a global."
	"Smalltalk unusedClasses asSortedCollection"

	^ self allUnusedClassesWithout: {{}. {}}! !

!SystemDictionary methodsFor: 'private' stamp: 'jmv 4/7/2009 14:23'!
allSymbolsIn: anArray do: aBlock
	"Recursively dig into anArray and evaluate aBlock on any Symbols found"
	"allSymbols and variableBindings"
	
	anArray do: [ :elem |
		((elem isMemberOf: Symbol) or: [ elem isVariableBinding ])
			ifTrue: [ aBlock value: elem ]
			ifFalse: [
				(elem isMemberOf: Array) ifTrue: [ 
					self allSymbolsIn: elem do: aBlock ]]]! !

