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@0 corner: 1@max) -> [self buildMessageListWith: builder]. (0@max corner: 1@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!
vm-dev@lists.squeakfoundation.org