[Vm-dev] VM Maker: VMMakerExtras-eem.1.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Jan 25 19:44:27 UTC 2016


Eliot Miranda uploaded a new version of VMMakerExtras to project VM Maker:
http://source.squeak.org/VMMaker/VMMakerExtras-eem.1.mcz

==================== Summary ====================

Name: VMMakerExtras-eem.1
Author: eem
Time: 25 January 2016, 11:44:25.49695 am
UUID: 38898144-cfc0-4f43-ae17-ac2c0555aee3
Ancestors: 

Tools useful for VMMaker.  MessageSetDifferencer compareClass: ClassA to: ClassB keepSame: keepSame opens a view that compares methods in two different classes.  If keepSame is false, only differing (including present only in one) methods are displayed.

==================== Snapshot ====================

SystemOrganization addCategory: #'VMMakerExtras-Tools'!

----- Method: MethodReference>>isMethodReference (in category '*VMMakerExtras-Tools-testing') -----
isMethodReference
	^true!

----- Method: Object>>isMethodReference (in category '*VMMakerExtras-Tools-testing') -----
isMethodReference
	^false!

TextDiffBuilder subclass: #CodeDiffBuilder
	instanceVariableNames: 'class'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'VMMakerExtras-Tools'!

!CodeDiffBuilder commentStamp: '<historical>' prior: 0!
I am a differencer that compares source in tokens tokenised by a parser.  I consider comments significant, but consider sequences of whitespace equivalent.  Depending on the definition of WhitespaceForCodeDiff>>at: sequences of whitespace containing carriage-returns may be considered different to sequences of whitespace lacking carriage-returns (which may result in better-formatted diffs).!

----- Method: CodeDiffBuilder>>formatLine: (in category 'initialize') -----
formatLine: aString
	^aString!

----- Method: CodeDiffBuilder>>split: (in category 'initialize') -----
split: aString
	^self split: aString parser: (class ifNil: [Object] ifNotNil: [class]) parserClass new!

----- Method: CodeDiffBuilder>>split:parser: (in category 'initialize') -----
split: aString parser: aParserOrScanner
	| tokens index |
	tokens := OrderedCollection new.
	index := 1.
	aParserOrScanner scanTokenPositionsIn: aString into:
		[:start :end|
		index < start ifTrue:
			[tokens add: (WhitespaceForCodeDiff new string: (aString copyFrom: index to: start - 1))].
		tokens addLast: (DiffElement string: (aString copyFrom: start to: end)).
		index := end + 1].
	index < aString size ifTrue:
		[tokens add: (WhitespaceForCodeDiff new string: (aString copyFrom: index to: aString size))].
	^tokens!

DiffElement subclass: #WhitespaceForCodeDiff
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'VMMakerExtras-Tools'!

!WhitespaceForCodeDiff commentStamp: '<historical>' prior: 0!
I am a special form of whitespace for code diffing.  I masquerade as a string of a single space but remember my actual whitespace. Depending on the definition of at: I may differentiate between whitespace containing a line break from whitespace that doesn't, (which may result in better-formatted diffs).!

----- Method: WhitespaceForCodeDiff>>= (in category 'comparing') -----
= anOtherObject
	^self species == anOtherObject species!

----- Method: WhitespaceForCodeDiff>>at: (in category 'accessing') -----
at: index
	^1 = index
		ifTrue: ["(string includes: Character cr)
					ifTrue: [Character cr]
					ifFalse: ["Character space"]"]
		ifFalse: [super at: index]!

----- Method: WhitespaceForCodeDiff>>isOctetString (in category 'testing') -----
isOctetString
	"For DiffElement>>string:"
	^false!

----- Method: WhitespaceForCodeDiff>>match: (in category 'comparing') -----
match: anOtherObject
	^self species == anOtherObject species!

----- Method: WhitespaceForCodeDiff>>size (in category 'accessing') -----
size
	^1!

----- Method: WhitespaceForCodeDiff>>string: (in category 'accessing') -----
string: aString
	super string: aString.
	hash := ' ' hash!

Browser subclass: #MessageSetDifferencer
	instanceVariableNames: 'messageList leftSet rightSet autoSelectString'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'VMMakerExtras-Tools'!

!MessageSetDifferencer commentStamp: '<historical>' prior: 0!
This is a variation of MessageSet that allows diffing of arbitrary definitions.  It is initialized with pairs of definitions, each pair being compared against each other.!

----- Method: MessageSetDifferencer class>>compareClass:to: (in category 'instance creation') -----
compareClass: aClass to: bClass
	^self compareClass: aClass to: bClass keepSame: true

	"MessageSetDifferencer compareClass: InterpreterStackPages to: CoInterpreterStackPages"
	"MessageSetTextDifferencer compareClass: InterpreterStackPages to: CoInterpreterStackPages"!

----- Method: MessageSetDifferencer class>>compareClass:to:keepSame: (in category 'instance creation') -----
compareClass: aClass to: bClass keepSame: keepSame
	| definitionPairSequence |
	definitionPairSequence := { { ClassReference class: aClass. ClassReference class: bClass } },
							((aClass selectors, bClass selectors) asSet asSortedCollection
								select: [:s| keepSame or: [(aClass sourceCodeAt: s ifAbsent: ['']) asString ~= (bClass sourceCodeAt: s ifAbsent: ['']) asString]]
								thenCollect:
									[:s| {
										MethodReference class: aClass selector: s. 
										MethodReference class: bClass selector: s }]).
	^self openMessageList: definitionPairSequence name: aClass name, ' <-> ', bClass name autoSelect: nil

	"MessageSetDifferencer compareClass: InterpreterStackPages to: CoInterpreterStackPages keepSame: true"
	"MessageSetTextDifferencer compareClass: ReentrantFFIPlugin to: ThreadedFFIPlugin keepSame: false"
	"MessageSetDifferencer compareClass: NewsqueakIA32ABIPlugin to: IA32ABIPlugin keepSame: false"!

----- Method: MessageSetDifferencer class>>definitionPairs: (in category 'instance creation') -----
definitionPairs: aSequence
	^self new initializeDefinitionPairs: aSequence!

----- Method: MessageSetDifferencer class>>openMessageList:name:autoSelect: (in category 'instance creation') -----
openMessageList: definitionPairSequence name: labelString autoSelect: autoSelectString
	"Open a system view for a MessageSetDifferencer on definitionPairSequence. "

	| differencer |
	differencer := self definitionPairs: definitionPairSequence.
	differencer autoSelectString: autoSelectString.
	^ToolBuilder open: differencer label: labelString!

----- Method: MessageSetDifferencer>>aboutToStyle: (in category 'contents') -----
aboutToStyle: aPluggableShoutMorphOrView
	"Style if there is only one definition (none styles nothing)"
	^(leftSet selection isNil or: [rightSet selection isNil])
	   and: [aPluggableShoutMorphOrView classOrMetaClass:
				(leftSet selection
					ifNotNil: [leftSet selection isClassReference ifFalse: [leftSet selection actualClass]]
					ifNil: [rightSet selection ifNotNil:
							[rightSet selection isClassReference ifFalse: [rightSet selection actualClass]]]).
			true]!

----- Method: MessageSetDifferencer>>annotation (in category 'accessing') -----
annotation
	"Provide a line of content for an annotation pane, representing information about
	 the method associated with the selected class and selector in the receiver."
	| left right |
	(left := leftSet annotation) = (right := rightSet annotation) ifTrue:
		[^left].
	left = '------' ifTrue:
		[^'> ', right].
	right = '------' ifTrue:
		[^left, ' <'].
	^left, ' <-> ', right!

----- Method: MessageSetDifferencer>>autoSelectString (in category 'private') -----
autoSelectString
	"Return the string to be highlighted when making new selections"
	^ autoSelectString!

----- Method: MessageSetDifferencer>>autoSelectString: (in category 'private') -----
autoSelectString: aString
	"Set the string to be highlighted when making new selections"
	autoSelectString := aString!

----- Method: MessageSetDifferencer>>buildWith: (in category 'toolbuilder') -----
buildWith: builder
	| windowSpec max result |
	self wantsOptionalButtons ifTrue:[max := 0.3] ifFalse:[max := 0.3].
	windowSpec := self buildWindowWith: builder specs: {
		(0 at 0 corner: 1 at max) -> [self buildMessageListWith: builder].
		(0 at max corner: 1 at 1) -> [self buildCodePaneWith: builder].
	}.
	result := builder build: windowSpec.
	autoSelectString ifNotNil:[self changed: #autoSelect].
	^result!

----- Method: MessageSetDifferencer>>changeDefinitions: (in category 'message list') -----
changeDefinitions: newList
	leftSet initializeMessageList:  (newList collect: [:ea| ea first]).
	rightSet initializeMessageList:  (newList collect: [:ea| ea last]).
	messageList := newList.
	self reformulateList;
		changed: #messageList!

----- Method: MessageSetDifferencer>>contents (in category 'contents') -----
contents
	"Answer the contents of the receiver"

	| left right |
	left := leftSet selection.
	right := rightSet selection.
	(left isNil and: [right isNil]) ifTrue:
		[currentCompiledMethod := nil.
		 ^''].
	left isNil ifTrue:
		[^rightSet contents].
	right isNil ifTrue:
		[^leftSet contents].
	left := leftSet contents.
	right := rightSet contents.
	^leftSet selection isMethodReference
		ifTrue:
			[CodeDiffBuilder
				buildDisplayPatchFrom: right
				to: left
				inClass: (leftSet selection isMethodReference ifTrue: [leftSet selection actualClass])
				prettyDiffs: true]
		ifFalse:
			[CodeDiffBuilder buildDisplayPatchFrom: right to: left]!

----- Method: MessageSetDifferencer>>initializeDefinitionPairs: (in category 'initialize-release') -----
initializeDefinitionPairs: aSequence
	leftSet := MessageSet messageList: (aSequence collect: [:ea| ea first]).
	rightSet := MessageSet messageList: (aSequence collect: [:ea| ea last]).
	messageList := aSequence.
	contents := ''!

----- Method: MessageSetDifferencer>>listEntryForIndex: (in category 'message list') -----
listEntryForIndex: index
	^(leftSet messageList at: index) asStringOrText, ' <-> ', (rightSet messageList at: index) asStringOrText!

----- Method: MessageSetDifferencer>>messageList (in category 'message list') -----
messageList
	"Answer the current list of messages."

	^messageList!

----- Method: MessageSetDifferencer>>messageListIndex: (in category 'message list') -----
messageListIndex: anInteger 
	"Set the index of the selected item to be anInteger."

	leftSet messageListIndex: anInteger.
	rightSet messageListIndex: anInteger.
	currentCompiledMethod := leftSet selection
								ifNotNil: [[leftSet selection compiledMethod]
											on: KeyNotFound
											do: [:ex| nil]]
								ifNil: [rightSet selection ifNotNil:
										[[rightSet selection compiledMethod
											on: KeyNotFound
											do: [:ex| nil]]]].
	contents := ''.
	self changed: #messageListIndex.	 "update my selection"
	self editSelection: #editMessage.
	self contentsChanged.
	autoSelectString ifNotNil: [self changed: #autoSelect].
	self decorateButtons!

----- Method: MessageSetDifferencer>>messageListMenu:shifted: (in category 'message list') -----
messageListMenu: aMenu shifted: shifted 
	"Answer the message-list menu"
	(self menuHook: aMenu named: #messageListMenu shifted: shifted) ifTrue:[^aMenu].
	shifted ifTrue: [^ self shiftedMessageListMenu: aMenu].
	aMenu addList: #(
			('browse full (b)' 			browseMethodFull)
			('browse hierarchy (h)'			classHierarchy)
			('browse method (O)'			openSingleMessageBrowser)
			('browse protocol (p)'			browseFullProtocol)
			-
			('fileOut'				fileOutMessage)
			('printOut'				printOutMessage)
			-
			('senders of... (n)'			browseSendersOfMessages)
			('implementors of... (m)'		browseMessages)
			('inheritance (i)'			methodHierarchy)
			('versions (v)'				browseVersions)
			-
			('inst var refs...'			browseInstVarRefs)
			('inst var defs...'			browseInstVarDefs)
			('class var refs...'			browseClassVarRefs)
			('class variables'			browseClassVariables)
			('class refs (N)'			browseClassRefs)
			-
			('remove unchanged'		removeUnchangedDefinitions)
			('remove changed'			removeChangedDefinitions)
			-
			('more...'				shiftedYellowButtonActivity)).
	^ aMenu!

----- Method: MessageSetDifferencer>>removeChangedDefinitions (in category 'message list') -----
removeChangedDefinitions
	self changeDefinitions: (messageList select: [:pair| pair first sourceString = pair second sourceString])!

----- Method: MessageSetDifferencer>>removeUnchangedDefinitions (in category 'message list') -----
removeUnchangedDefinitions
	self changeDefinitions: (messageList reject: [:pair| pair first sourceString = pair second sourceString])!

----- Method: MessageSetDifferencer>>selectedClassOrMetaClass (in category 'class list') -----
selectedClassOrMetaClass
	"Answer the currently selected class (or metaclass)."
	^leftSet selectedClassOrMetaClass
		ifNotNil: [:leftBehavior| leftBehavior]
		ifNil: [rightSet selectedClassOrMetaClass ifNotNil:
				[:rightBehavior| rightBehavior]]!

----- Method: MessageSetDifferencer>>selectedMessageName (in category 'accessing') -----
selectedMessageName
	"Answer the message selector of the currently selected message, if any. 
	 Answer nil otherwise."
	| selectedMessageName class tree plainClassDefinition |
	selectedMessageName := leftSet selectedMessageName
								ifNotNil: [:leftMessage| leftMessage]
								ifNil: [rightSet selectedMessageName ifNotNil:
										[:rightMessage| rightMessage]].
	(#(Definition Hierarchy Comment) includes: selectedMessageName) ifFalse:
		[^selectedMessageName].
	#Definition ~~ selectedMessageName ifTrue:
		[^nil].
	(plainClassDefinition := leftSet contents) isEmpty ifTrue:
							[plainClassDefinition := rightSet contents].
	class := self selectedClassOrMetaClass.
	tree := class subclassDefinerClass parserClass new
				parse: plainClassDefinition readStream
				class: class
				noPattern: true
				notifying: nil
				ifFail: [].
	"Demeter, who (tf) is Demeter??"
	^tree block statements first expr selector key!

MessageSetDifferencer subclass: #MessageSetTextDifferencer
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'VMMakerExtras-Tools'!

----- Method: MessageSetTextDifferencer>>contents (in category 'contents') -----
contents
	"Answer the contents of the receiver"

	| left right |
	left := leftSet selection.
	right := rightSet selection.
	(left isNil and: [right isNil]) ifTrue:
		[currentCompiledMethod := nil.
		 ^''].
	left isNil ifTrue:
		[^rightSet contents].
	right isNil ifTrue:
		[^leftSet contents].
	^TextDiffBuilder buildDisplayPatchFrom: rightSet contents to: leftSet contents!



More information about the Vm-dev mailing list