[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