dc: improve performance

packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st

@@ -88,7 +88,7 @@ DCChawatheScriptGenerator >> generateFrom: src to: dest in: aMapping [
 		destInOrder add: x.
 		self alignChildrenSrc: w dest: x srcInOrder: srcInOrder destInOrder: destInOrder in: aMapping].
 
-	src allMorphsDo: [:w | ((aMapping isSrcMapped: w) not and: [(inserted includes: w) not]) ifTrue: [self delete: w]]
+	(Array streamContents: [:s | src allMorphsDo: [:w | ((aMapping isSrcMapped: w) not and: [(inserted includes: w) not]) ifTrue: [s nextPut: w]]]) do: [:w | self delete: w]
 ]
 
 { #category : #actions }

packages/DomainCode-Diff/DCCommandScriptGenerator.class.st

@@ -44,6 +44,7 @@ DCCommandScriptGenerator >> insert: aMorph at: aNumber in: anOwnerMorph [
 		index: aNumber;
 		container: anOwnerMorph;
 		morph: aMorph).
+	self maybeAttachFlash: aMorph.
 	self logChanges ifTrue: [Transcript showln: {#insert. anOwnerMorph. aNumber. aMorph}]
 ]
 
@@ -61,6 +62,7 @@ DCCommandScriptGenerator >> move: aMorph to: anOwnerMorph at: aNumber [
 		container: anOwnerMorph;
 		morph: aMorph;
 		index: aNumber).
+	self maybeAttachFlash: aMorph.
 	self logChanges ifTrue: [Transcript showln: {#move. anOwnerMorph. aNumber. aMorph}]
 ]
 
@@ -76,5 +78,6 @@ DCCommandScriptGenerator >> update: aMorph with: aString [
 				target: aMorph;
 				selector: #contents;
 				value: aString)].
+	self maybeAttachFlash: aMorph.
 	self logChanges ifTrue: [Transcript showln: {#update. aMorph. aString}]
 ]

packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st

@@ -1,6 +1,10 @@
 Class {
 	#name : #DCGreedyBottomUpMatcher,
 	#superclass : #Object,
+	#instVars : [
+		'rootDest',
+		'sizeThreshold'
+	],
 	#category : #'DomainCode-Diff'
 }
 
@@ -20,7 +24,7 @@ DCGreedyBottomUpMatcher >> destCandidatesFor: src in: aMapping [
 			parent := current owner.
 			parent notNil and: [(visited includes: parent) not]] whileTrue: [
 			visited add: parent.
-			(parent type = src type and: [((aMapping isDestMapped: parent) or: [parent = parent rootBlock]) not]) ifTrue: [candidates add: parent].
+			(parent type = src type and: [((aMapping isDestMapped: parent) or: [parent = rootDest]) not]) ifTrue: [candidates add: parent].
 			current := parent]].
 
 	^ candidates
@@ -38,8 +42,8 @@ DCGreedyBottomUpMatcher >> lastChanceMatchFrom: src to: dest in: aMapping [
 
 { #category : #'as yet unclassified' }
 DCGreedyBottomUpMatcher >> matchFrom: src to: dest in: aMapping [
-	"post-order"
 
+	rootDest := dest.
 	src allMorphsDo: [:t |
 		src = t
 			ifTrue: [
@@ -61,5 +65,11 @@ DCGreedyBottomUpMatcher >> similarityThreshold [
 { #category : #'as yet unclassified' }
 DCGreedyBottomUpMatcher >> sizeThreshold [
 
-	^ 1000
+	^ sizeThreshold ifNil: [5]
+]
+
+{ #category : #'as yet unclassified' }
+DCGreedyBottomUpMatcher >> sizeThreshold: aNumber [
+
+	sizeThreshold := aNumber
 ]

packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st

@@ -1,14 +1,20 @@
 Class {
 	#name : #DCGreedySubtreeMatcher,
 	#superclass : #Object,
+	#instVars : [
+		'rootSrc',
+		'rootDest'
+	],
 	#category : #'DomainCode-Diff'
 }
 
 { #category : #'as yet unclassified' }
 DCGreedySubtreeMatcher >> handleAmbiguousMappings: aCollection for: aMapping [
 
 	| comparator |
-	comparator := DCMappingComparator new mappingStore: aMapping.
+	comparator := DCMappingComparator new
+		rootSrc: rootSrc rootDest: rootDest;
+		mappingStore: aMapping.
 
 	aCollection sort: [:m1 :m2 | | s1 s2 |
 		s1 := m1 first detectMax: [:t | t recursiveSubmorphCount].
@@ -25,6 +31,9 @@ DCGreedySubtreeMatcher >> handleAmbiguousMappings: aCollection for: aMapping [
 DCGreedySubtreeMatcher >> matchFrom: src to: dest in: aMapping [
 
 	| ambiguousMappings srcTrees destTrees |
+	rootSrc := src.
+	rootDest := dest.
+
 	ambiguousMappings := OrderedCollection new.
 	srcTrees := DCPriorityTreeQueue new add: src.
 	destTrees := DCPriorityTreeQueue new add: dest.
@@ -34,6 +43,7 @@ DCGreedySubtreeMatcher >> matchFrom: src to: dest in: aMapping [
 		mapper := DCHashBasedMapper new.
 		srcTrees removeHighest do: [:t | mapper addSrc: t].
 		destTrees removeHighest do: [:t | mapper addDest: t].
+
 		mapper uniqueEntries do: [:entry | aMapping addRecursiveMappingFrom: entry first anyOne to: entry second anyOne].
 		ambiguousMappings addAll: mapper ambiguousEntries.
 		mapper unmappedEntries do: [:entry |

packages/DomainCode-Diff/DCLeftOverLeafMatcher.class.st

@@ -0,0 +1,73 @@
+Class {
+	#name : #DCLeftOverLeafMatcher,
+	#superclass : #Object,
+	#instVars : [
+		'rootSrc',
+		'rootDest'
+	],
+	#category : #'DomainCode-Diff'
+}
+
+{ #category : #'as yet unclassified' }
+DCLeftOverLeafMatcher >> handleAmbiguousMappings: aCollection for: aMapping [
+
+	| comparator |
+	comparator := DCMappingComparator new
+		rootSrc: rootSrc rootDest: rootDest;
+		mappingStore: aMapping.
+
+	aCollection sort: [:m1 :m2 | | s1 s2 |
+		s1 := m1 first detectMax: [:t | t recursiveSubmorphCount].
+		s2 := m2 first detectMax: [:t | t recursiveSubmorphCount].
+		s1 recursiveSubmorphCount < s2 recursiveSubmorphCount].
+
+	aCollection do: [:entry | | candidates |
+		candidates := Array streamContents: [:s | entry first do: [:src | entry second do: [:dest | s nextPut: {src. dest}]]].
+
+		(candidates sort: [:m1 :m2 | (comparator compare: m1 with: m2) <= 0]) do: [:mapping | (aMapping areBothUnmappedSrc: mapping first dest: mapping second) ifTrue: [aMapping addRecursiveMappingFrom: mapping first to: mapping second]]]
+]
+
+{ #category : #'as yet unclassified' }
+DCLeftOverLeafMatcher >> matchFrom: src to: dest in: aMapping [
+
+	| ambiguousMappings srcTrees destTrees |
+	rootSrc := src.
+	rootDest := dest.
+
+	ambiguousMappings := OrderedCollection new.
+	srcTrees := DCPriorityTreeQueue new
+		minimumHeight: 0;
+		addAll: (Array streamContents: [:s | src allMorphsDo: [:k | (aMapping isSrcMapped: k) ifFalse: [s nextPut: k]]]).
+	destTrees := DCPriorityTreeQueue new
+		minimumHeight: 0;
+		addAll: (Array streamContents: [:s | dest allMorphsDo: [:k | (aMapping isDestMapped: k) ifFalse: [s nextPut: k]]]).
+
+	[
+		self synchronizePriority: srcTrees with: destTrees.
+		srcTrees notEmpty and: [destTrees notEmpty]] whileTrue: [ | mapper |
+		mapper := DCHashBasedMapper new.
+		srcTrees removeHighest do: [:t | mapper addSrc: t].
+		destTrees removeHighest do: [:t | mapper addDest: t].
+		mapper uniqueEntries do: [:entry | aMapping addRecursiveMappingFrom: entry first anyOne to: entry second anyOne].
+		ambiguousMappings addAll: mapper ambiguousEntries.
+		mapper unmappedEntries do: [:entry |
+			entry first do: [:t | srcTrees addTree: t].
+			entry second do: [:t | destTrees addTree: t]]].
+
+	self handleAmbiguousMappings: ambiguousMappings for: aMapping
+]
+
+{ #category : #'as yet unclassified' }
+DCLeftOverLeafMatcher >> synchronizePriority: aQueue with: anotherQueue [
+
+	[(aQueue notEmpty and: [anotherQueue notEmpty]) and: [aQueue first treeHeight ~= anotherQueue first treeHeight]] whileTrue: [
+		aQueue first treeHeight > anotherQueue first treeHeight
+			ifTrue: [aQueue removeHighestAndOpen]
+			ifFalse: [anotherQueue removeHighestAndOpen]].
+
+	(aQueue isEmpty or: [anotherQueue isEmpty]) ifTrue: [
+		aQueue removeAll.
+		anotherQueue removeAll.
+		^ false].
+	^ true
+]

packages/DomainCode-Diff/DCMappingComparator.class.st

@@ -6,7 +6,9 @@ Class {
 		'destDescendants',
 		'mappingStore',
 		'srcAncestors',
-		'destAncestors'
+		'destAncestors',
+		'rootSrc',
+		'rootDest'
 	],
 	#category : #'DomainCode-Diff'
 }
@@ -65,9 +67,9 @@ DCMappingComparator >> distanceAbsoluteCompare: aMapping with: anotherMapping [
 
 	| position distance |
 	"compare the post-order position in the tree of the mapping, between src and dest"
-	position := [:tree | tree rootBlock absolutePositionOf: tree].
-	distance := [:mapping | ((position value: mapping first) - (position value: mapping second)) abs].
-	^ ((distance value: anotherMapping) - (distance value: aMapping)) sign
+	position := [:tree :root | root absolutePositionOf: tree].
+	distance := [:mapping | ((position value: mapping first value: rootSrc) - (position value: mapping second value: rootDest)) abs].
+	^ ((distance value: aMapping) - (distance value: anotherMapping)) sign
 ]
 
 { #category : #'as yet unclassified' }
@@ -76,7 +78,7 @@ DCMappingComparator >> distanceTextualCompare: aMapping with: anotherMapping [
 	| distance |
 	"compares how far each mapping moved from src to dest in terms of its textual start and end indices"
 	distance := [:mapping | (mapping first range start index - mapping second range start index) abs + (mapping first range end index - mapping second range end index) abs].
-	^ ((distance value: anotherMapping) - (distance value: aMapping)) sign
+	^ ((distance value: aMapping) - (distance value: anotherMapping)) sign
 ]
 
 { #category : #'as yet unclassified' }
@@ -144,16 +146,27 @@ DCMappingComparator >> numberOfCommonParentsIn: src and: dest [
 	^ (self longestCommonSubsequenceWith: (srcAncestors at: src) and: (destAncestors at: dest)) size
 ]
 
+{ #category : #'as yet unclassified' }
+DCMappingComparator >> rootSrc: aBlock rootDest: anotherBlock [
+
+	rootSrc := aBlock.
+	rootDest := anotherBlock
+]
+
 { #category : #'as yet unclassified' }
 DCMappingComparator >> similarityParentsCompare: aMapping with: anotherMapping [
 
 	| s1 s2 |
 	(aMapping first owner = anotherMapping first owner and: [aMapping second owner = anotherMapping second owner]) ifTrue: [^ 0].
 
-	srcAncestors at: aMapping first ifAbsentPut: aMapping first allParents.
-	destAncestors at: aMapping second ifAbsentPut: aMapping second allParents.
-	srcAncestors at: anotherMapping first ifAbsentPut: anotherMapping first allParents.
-	destAncestors at: anotherMapping second ifAbsentPut: anotherMapping second allParents.
+	srcAncestors at: aMapping first ifAbsentPut: (aMapping first allParentsUpTo: rootSrc).
+	destAncestors at: aMapping second ifAbsentPut: (aMapping second allParentsUpTo: rootDest).
+	srcAncestors
+		at: anotherMapping first
+		ifAbsentPut: (anotherMapping first allParentsUpTo: rootSrc).
+	destAncestors
+		at: anotherMapping second
+		ifAbsentPut: (anotherMapping second allParentsUpTo: rootDest).
 
 	s1 := self class
 		diceCoefficientCommon: (self numberOfCommonParentsIn: aMapping first and: aMapping second)
@@ -164,7 +177,7 @@ DCMappingComparator >> similarityParentsCompare: aMapping with: anotherMapping [
 		left: (srcAncestors at: anotherMapping first) size
 		right: (destAncestors at: anotherMapping second) size.
 
-	^ (s2 - s1) sign
+	^ (s1 - s2) sign
 ]
 
 { #category : #'as yet unclassified' }
@@ -186,7 +199,7 @@ DCMappingComparator >> similarityPositionInParentsCompare: aMapping with: anothe
 			to: (indicesVec1 size min: indicesVec2 size)
 			do: [:index | sum := sum + ((indicesVec1 at: index) - (indicesVec2 at: index)) squared].
 		sum sqrt].
-	^ ((distance value: anotherMapping) - (distance value: aMapping)) sign
+	^ ((distance value: aMapping) - (distance value: anotherMapping)) sign
 ]
 
 { #category : #'as yet unclassified' }
@@ -204,5 +217,5 @@ DCMappingComparator >> similaritySiblingsCompare: aMapping with: anotherMapping
 		left: (srcDescendants at: anotherMapping first owner) size
 		right: (destDescendants at: anotherMapping second owner) size.
 
-	^ (s2 - s1) sign
+	^ (s1 - s2) sign
 ]

packages/DomainCode-Diff/DCMappingStore.class.st

@@ -11,7 +11,7 @@ Class {
 { #category : #'as yet unclassified' }
 DCMappingStore >> addMappingFrom: src to: dest [
 
-	self assert: src rootBlock ~= dest rootBlock.
+	SBToggledCode comment: '' active: 0 do: {[src treeLabel = 'function' ifTrue: [self halt]]}.
 	srcToDest at: src put: dest.
 	destToSrc at: dest put: src
 ]
@@ -41,6 +41,12 @@ DCMappingStore >> destForSrc: t [
 	^ srcToDest at: t ifAbsent: [nil]
 ]
 
+{ #category : #'as yet unclassified' }
+DCMappingStore >> destToSrc [
+
+	^ destToSrc
+]
+
 { #category : #'as yet unclassified' }
 DCMappingStore >> initialize [
 
@@ -73,3 +79,9 @@ DCMappingStore >> srcForDest: t [
 
 	^ destToSrc at: t ifAbsent: [nil]
 ]
+
+{ #category : #'as yet unclassified' }
+DCMappingStore >> srcToDest [
+
+	^ srcToDest
+]

packages/DomainCode-Diff/DCMatcher.class.st

@@ -13,6 +13,20 @@ DCMatcher >> applyEditsIn: aDest to: aSrc [
 		in: (self matchFrom: aSrc to: aDest)
 ]
 
+{ #category : #'as yet unclassified' }
+DCMatcher >> commonAncestorOf: aCollection root: aTree [
+
+	| current |
+	aCollection ifEmpty: [^ nil].
+
+	current := aCollection first owner.
+	[current ~= aTree] whileTrue: [
+		(aCollection allSatisfy: [:t | t = current or: [t hasOwner: current]]) ifTrue: [^ current].
+		current := current owner].
+
+	^ aTree
+]
+
 { #category : #'as yet unclassified' }
 DCMatcher >> doCommandForEditsIn: aDest to: aSrc in: anEditor [
 
@@ -21,12 +35,59 @@ DCMatcher >> doCommandForEditsIn: aDest to: aSrc in: anEditor [
 		generateFrom: aSrc to: aDest in: (self matchFrom: aSrc to: aDest)
 ]
 
+{ #category : #'as yet unclassified' }
+DCMatcher >> fineGrainedMatch2From: src to: dest in: aMapping [
+
+	| topSrc topDest |
+	topSrc := self
+		commonAncestorOf: (Array streamContents: [:s | src allMorphsDo: [:k | (aMapping isSrcMapped: k) ifFalse: [s nextPut: k]]])
+		root: src.
+	topDest := self
+		commonAncestorOf: (Array streamContents: [:s | dest allMorphsDo: [:k | (aMapping isDestMapped: k) ifFalse: [s nextPut: k]]])
+		root: dest.
+	(topSrc notNil and: [topDest notNil]) ifTrue: [
+		SBToggledCode
+			comment: ''
+			active: 0
+			do: {[self assert: (aMapping destForSrc: topSrc owner) = topDest owner]}.
+		DCGreedyBottomUpMatcher new
+			sizeThreshold: 900000000;
+			lastChanceMatchFrom: topSrc to: topDest in: aMapping]
+]
+
+{ #category : #'as yet unclassified' }
+DCMatcher >> fineGrainedMatchFrom: src to: dest in: aMapping [
+
+	| topSrc topDest |
+	topSrc := (Array streamContents: [:s | src allMorphsDo: [:k | (aMapping isSrcMapped: k) ifFalse: [s nextPut: k]]]) detectMax: #treeHeight.
+	topDest := (Array streamContents: [:s | dest allMorphsDo: [:k | (aMapping isDestMapped: k) ifFalse: [s nextPut: k]]]) detectMax: #treeHeight.
+
+	self halt.
+	topSrc ifNotNil: [
+		self assert: (aMapping destForSrc: topSrc owner) = topDest owner.
+		DCGreedyBottomUpMatcher new
+			sizeThreshold: 900000000;
+			lastChanceMatchFrom: topSrc to: topDest in: aMapping]
+]
+
+{ #category : #'as yet unclassified' }
+DCMatcher >> largestUnmappedFor: aTree isSrc: aBoolean in: aMapping [
+
+	^ (Array streamContents: [:s | aTree allMorphsDo: [:k | (aBoolean ifTrue: [aMapping isSrcMapped: k] ifFalse: [aMapping isDestMapped: k]) ifFalse: [s nextPut: k]]]) detectMax: #treeHeight
+]
+
 { #category : #'as yet unclassified' }
 DCMatcher >> matchFrom: src to: dest [
 
 	| mappings |
 	mappings := DCMappingStore new.
 	DCGreedySubtreeMatcher new matchFrom: src to: dest in: mappings.
 	DCGreedyBottomUpMatcher new matchFrom: src to: dest in: mappings.
+	SBToggledCode
+		comment: ''
+		active: 0
+		do: {[DCLeftOverLeafMatcher new matchFrom: src to: dest in: mappings]}.
+	self fineGrainedMatch2From: src to: dest in: mappings.
+
 	^ mappings
 ]