From 5bd5af0a593937093b0356ca019424e873e8d6da Mon Sep 17 00:00:00 2001 From: Tom Beckmann Date: Sat, 30 Sep 2023 09:11:09 +0200 Subject: [PATCH] dc: improve performance --- .../DCChawatheScriptGenerator.class.st | 2 +- .../DCCommandScriptGenerator.class.st | 3 + .../DCGreedyBottomUpMatcher.class.st | 16 +++- .../DCGreedySubtreeMatcher.class.st | 12 ++- .../DCLeftOverLeafMatcher.class.st | 73 +++++++++++++++++++ .../DCMappingComparator.class.st | 37 +++++++--- .../DomainCode-Diff/DCMappingStore.class.st | 14 +++- packages/DomainCode-Diff/DCMatcher.class.st | 61 ++++++++++++++++ .../DCPriorityTreeQueue.class.st | 17 ++++- .../DCZhangShashaMatcher.class.st | 16 ++-- packages/DomainCode-Diff/Matrix.extension.st | 16 +++- packages/DomainCode-Diff/String.extension.st | 17 ++--- packages/DomainCode-Parser/DCBlock.class.st | 61 +++++++++++++--- .../DomainCode-Parser/DCEditTest.class.st | 12 +++ packages/DomainCode-Parser/DCText.class.st | 12 +++ 15 files changed, 319 insertions(+), 50 deletions(-) create mode 100644 packages/DomainCode-Diff/DCLeftOverLeafMatcher.class.st diff --git a/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st b/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st index 3adf3c8..67fbf3b 100644 --- a/packages/DomainCode-Diff/DCChawatheScriptGenerator.class.st +++ b/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 } diff --git a/packages/DomainCode-Diff/DCCommandScriptGenerator.class.st b/packages/DomainCode-Diff/DCCommandScriptGenerator.class.st index 5c1e2bb..d337eb5 100644 --- a/packages/DomainCode-Diff/DCCommandScriptGenerator.class.st +++ b/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}] ] diff --git a/packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st b/packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st index 7bc622a..4ac4a9d 100644 --- a/packages/DomainCode-Diff/DCGreedyBottomUpMatcher.class.st +++ b/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 ] diff --git a/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st b/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st index 917aae4..071fd18 100644 --- a/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st +++ b/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st @@ -1,6 +1,10 @@ Class { #name : #DCGreedySubtreeMatcher, #superclass : #Object, + #instVars : [ + 'rootSrc', + 'rootDest' + ], #category : #'DomainCode-Diff' } @@ -8,7 +12,9 @@ Class { 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 | diff --git a/packages/DomainCode-Diff/DCLeftOverLeafMatcher.class.st b/packages/DomainCode-Diff/DCLeftOverLeafMatcher.class.st new file mode 100644 index 0000000..e98a502 --- /dev/null +++ b/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 +] diff --git a/packages/DomainCode-Diff/DCMappingComparator.class.st b/packages/DomainCode-Diff/DCMappingComparator.class.st index d3d44d4..fe38282 100644 --- a/packages/DomainCode-Diff/DCMappingComparator.class.st +++ b/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 ] diff --git a/packages/DomainCode-Diff/DCMappingStore.class.st b/packages/DomainCode-Diff/DCMappingStore.class.st index aa59e5c..43812b8 100644 --- a/packages/DomainCode-Diff/DCMappingStore.class.st +++ b/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 +] diff --git a/packages/DomainCode-Diff/DCMatcher.class.st b/packages/DomainCode-Diff/DCMatcher.class.st index 40cefd0..d32de22 100644 --- a/packages/DomainCode-Diff/DCMatcher.class.st +++ b/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,6 +35,47 @@ 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 [ @@ -28,5 +83,11 @@ DCMatcher >> matchFrom: src to: dest [ 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 ] diff --git a/packages/DomainCode-Diff/DCPriorityTreeQueue.class.st b/packages/DomainCode-Diff/DCPriorityTreeQueue.class.st index 66106e5..ff5d9bc 100644 --- a/packages/DomainCode-Diff/DCPriorityTreeQueue.class.st +++ b/packages/DomainCode-Diff/DCPriorityTreeQueue.class.st @@ -2,7 +2,8 @@ Class { #name : #DCPriorityTreeQueue, #superclass : #Object, #instVars : [ - 'collection' + 'collection', + 'minimumHeight' ], #category : #'DomainCode-Diff' } @@ -13,6 +14,12 @@ DCPriorityTreeQueue >> add: tree [ tree treeHeight >= self minimumHeight ifTrue: [collection add: tree] ] +{ #category : #'as yet unclassified' } +DCPriorityTreeQueue >> addAll: aCollection [ + + aCollection do: [:tree | self add: tree] +] + { #category : #'as yet unclassified' } DCPriorityTreeQueue >> addTree: tree [ @@ -42,7 +49,13 @@ DCPriorityTreeQueue >> isEmpty [ { #category : #'as yet unclassified' } DCPriorityTreeQueue >> minimumHeight [ - ^ 1 + ^ minimumHeight ifNil: [0] +] + +{ #category : #'as yet unclassified' } +DCPriorityTreeQueue >> minimumHeight: aNumber [ + + minimumHeight := aNumber ] { #category : #'as yet unclassified' } diff --git a/packages/DomainCode-Diff/DCZhangShashaMatcher.class.st b/packages/DomainCode-Diff/DCZhangShashaMatcher.class.st index 9b4fb6d..70e672b 100644 --- a/packages/DomainCode-Diff/DCZhangShashaMatcher.class.st +++ b/packages/DomainCode-Diff/DCZhangShashaMatcher.class.st @@ -24,17 +24,14 @@ DCZhangShashaMatcher >> computeForestDistFrom: zsSrc at: i to: zsDest at: j in: ifTrue: [ | costUpdate cost | 1. costUpdate := self updateCostFrom: (zsSrc treeAt: di) to: (zsDest treeAt: dj). - cost := { - (forestDist at0: di - 1 at0: dj) + costDeletion. - (forestDist at0: di at0: dj - 1) + constInsertion. - (forestDist at0: di - 1 at0: dj - 1) + costUpdate} min. + cost := ((forestDist at0: di at0: dj - 1) + constInsertion min: (forestDist at0: di - 1 at0: dj - 1) + costUpdate) min: (forestDist at0: di - 1 at0: dj) + costDeletion. forestDist at0: di at0: dj put: cost. treeDist at0: di at0: dj put: cost] ifFalse: [ - forestDist at0: di at0: dj put: { - (forestDist at0: di - 1 at0: dj) + costDeletion. - (forestDist at0: di at0: dj - 1) + constInsertion. - (forestDist at0: (zsSrc lldAt: di) - 1 at0: (zsDest lldAt: dj) - 1) + (treeDist at0: di at0: dj)} min]]] + forestDist + at0: di + at0: dj + put: (((forestDist at0: di - 1 at0: dj) + costDeletion min: (forestDist at0: (zsSrc lldAt: di) - 1 at0: (zsDest lldAt: dj) - 1) + (treeDist at0: di at0: dj)) min: (forestDist at0: di at0: dj - 1) + constInsertion)]]] ] { #category : #'as yet unclassified' } @@ -94,6 +91,7 @@ DCZhangShashaMatcher >> levenshteinDistanceFrom: aString to: anotherString [ DCZhangShashaMatcher >> matchFrom: src to: dest in: aMappingStore [ | zsSrc zsDest treePairQueue rootNodePair forestDist treeDist | + SBToggledCode comment: '' active: 0 do: {[Transcript showln: {src. dest}]}. zsSrc := DCZhangShashaTree new for: src. zsDest := DCZhangShashaTree new for: dest. @@ -110,7 +108,7 @@ DCZhangShashaMatcher >> matchFrom: src to: dest in: aMappingStore [ rootNodePair ifTrue: [rootNodePair := false] ifFalse: [ "need to recalc tree/forestDist?" self flag: #todo. - SBToggledCode comment: '' active: 0 do: { + SBToggledCode comment: '' active: 1 do: { [self computeForestDistFrom: zsSrc at: lastRow to: zsDest at: lastCol in: forestDist treeDist: treeDist]}]. firstRow := (zsSrc lldAt: lastRow) - 1. diff --git a/packages/DomainCode-Diff/Matrix.extension.st b/packages/DomainCode-Diff/Matrix.extension.st index 49a9d5c..435d84c 100644 --- a/packages/DomainCode-Diff/Matrix.extension.st +++ b/packages/DomainCode-Diff/Matrix.extension.st @@ -3,11 +3,23 @@ Extension { #name : #Matrix } { #category : #'*DomainCode-Diff' } Matrix >> at0: row at0: column [ - ^ self at: row + 1 at: column + 1 + ^ contents at: row * ncols + (column + 1) ] { #category : #'*DomainCode-Diff' } Matrix >> at0: row at0: column put: anObject [ - ^ self at: row + 1 at: column + 1 put: anObject + ^ contents at: row * ncols + (column + 1) put: anObject +] + +{ #category : #'*DomainCode-Diff' } +Matrix >> atFast: row at: column [ + + ^ contents at: row - 1 * ncols + column +] + +{ #category : #'*DomainCode-Diff' } +Matrix >> atFast: row at: column put: anObject [ + + ^ contents at: row - 1 * ncols + column put: anObject ] diff --git a/packages/DomainCode-Diff/String.extension.st b/packages/DomainCode-Diff/String.extension.st index 466d369..8db4e23 100644 --- a/packages/DomainCode-Diff/String.extension.st +++ b/packages/DomainCode-Diff/String.extension.st @@ -4,24 +4,23 @@ Extension { #name : #String } String >> levenshteinDistanceTo: anotherString [ | stab cost | - "if a string is empty, answer the length of the another string" - "code taken from Olivier Auverlot's Phonetix package" - self size = 0 ifTrue: ["return the Levenshtein distance between two strings" - ^ anotherString size]. + "consider https://docs.python.org/3/library/difflib.html" + self size = 0 ifTrue: [^ anotherString size]. anotherString size = 0 ifTrue: [^ self size]. + stab := Matrix rows: anotherString size + 1 columns: self size + 1. - 1 to: stab columnCount do: [:i | stab at: 1 at: i put: i - 1]. - 1 to: stab rowCount do: [:i | stab at: i at: 1 put: i - 1]. + 1 to: stab columnCount do: [:i | stab atFast: 1 at: i put: i - 1]. + 1 to: stab rowCount do: [:i | stab atFast: i at: 1 put: i - 1]. 2 to: stab columnCount do: [:i | 2 to: stab rowCount do: [:j | (self at: i - 1) = (anotherString at: j - 1) ifTrue: [cost := 0] ifFalse: [cost := 1]. stab - at: j + atFast: j at: i - put: ({(stab at: j at: i - 1) + 1. (stab at: j - 1 at: i) + 1. (stab at: j - 1 at: i - 1) + cost} asSortedCollection: [:a :b | a < b]) first]]. - ^ stab at: stab rowCount at: stab columnCount + put: (((stab atFast: j at: i - 1) + 1 min: (stab atFast: j - 1 at: i - 1) + cost) min: (stab atFast: j - 1 at: i) + 1)]]. + ^ stab atFast: stab rowCount at: stab columnCount ] { #category : #'*DomainCode-Diff' } diff --git a/packages/DomainCode-Parser/DCBlock.class.st b/packages/DomainCode-Parser/DCBlock.class.st index bb2feb0..6fbc8e5 100644 --- a/packages/DomainCode-Parser/DCBlock.class.st +++ b/packages/DomainCode-Parser/DCBlock.class.st @@ -133,10 +133,18 @@ DCBlock >> alias [ { #category : #'as yet unclassified' } DCBlock >> allParents [ + ^ self allParentsUpTo: self rootBlock +] + +{ #category : #'as yet unclassified' } +DCBlock >> allParentsUpTo: aBlock [ + + self = aBlock ifTrue: [^ #()]. + ^ Array streamContents: [:s | - self ownerSatisfying: [:o | + self assert: (self ownerSatisfying: [:o | s nextPut: o. - o = self rootBlock]] + o = aBlock]) notNil] ] { #category : #'as yet unclassified' } @@ -164,6 +172,13 @@ DCBlock >> contentsToDisplay [ ^ self contents ] +{ #category : #'as yet unclassified' } +DCBlock >> copyRangesFrom: newTree to: oldTree [ + + oldTree range: newTree range. + newTree submorphs with: oldTree submorphs do: [:a :b | self copyRangesFrom: a to: b] +] + { #category : #'as yet unclassified' } DCBlock >> currentTextMorph [ @@ -171,6 +186,17 @@ DCBlock >> currentTextMorph [ ^ nil ] +{ #category : #'as yet unclassified' } +DCBlock >> deleteAfterCursor [ + + + self tryApplyChange: [:source :textMorph :cursorIndex :apply | + self + deleteFrom: source + at: cursorIndex + 1 + do: [:new :edit | apply value: new value: edit value: cursorIndex]] +] + { #category : #'as yet unclassified' } DCBlock >> deleteBeforeCursor [ @@ -240,7 +266,7 @@ DCBlock >> findLastMatchingAncesors: aCollection oldTree: aBlock [ ^ {oldCurrent owner. newCurrent owner}]]. self assert: aCollection first type = oldCurrent type. - ^ {aCollection first. oldCurrent} + ^ {oldCurrent. aCollection first} ] { #category : #'as yet unclassified' } @@ -580,8 +606,6 @@ DCBlock >> replace: oldTree with: newTree [ editor := self sandblockEditor. DCMatcher new doCommandForEditsIn: newTree to: oldTree in: editor. editor history noMoreMerge. - oldTree setProperty: #tsTree toValue: (newTree valueOfProperty: #tsTree). - oldTree setProperty: #tsSource toValue: (newTree valueOfProperty: #tsSource). oldTree]. [ self sandblockEditor do: (SBReplaceCommand new @@ -767,12 +791,29 @@ DCBlock >> tryApplyChange: aClosure [ value: [:newSource :edit :newIndex | newTree := DCBlock parse: newSource old: oldTree edit: edit language: self language. - newTree second ifNotEmpty: [:changedRanges | | change newContained | - change := SBTSRange merging: changedRanges. - newContained := newTree first smallestBlockEncompassig: change. - self findLastMatchingAncesors: {newContained}, newContained allParents oldTree: oldTree]. + SBToggledCode comment: '' active: 1 do: { + [self replace: oldTree with: newTree first]. + [ + newTree second + ifNotEmpty: [:changedRanges | | change newContained pair | + change := SBTSRange merging: changedRanges. + newContained := newTree first smallestBlockEncompassig: change. + pair := self findLastMatchingAncesors: {newContained}, newContained allParents oldTree: oldTree. + self replace: pair first with: pair second] + ifEmpty: [ | pair | + "empty change means no structures were changed, only contents" + pair := self + findLastMatchingAncesors: { + self sandblockEditor currentInputCommand ifNotNil: #textMorph. + self sandblockEditor currentInputCommand ifNotNil: #block}, (self sandblockEditor currentInputCommand ifNotNil: #block) allParents + oldTree: newTree first. + pair second contents: pair first contents]. + self copyRangesFrom: newTree first to: oldTree]}. + + oldTree + setProperty: #tsTree toValue: (newTree first valueOfProperty: #tsTree); + setProperty: #tsSource toValue: (newTree first valueOfProperty: #tsSource). - self replace: oldTree with: newTree first. self placeCursorIn: oldTree at: newIndex] ] diff --git a/packages/DomainCode-Parser/DCEditTest.class.st b/packages/DomainCode-Parser/DCEditTest.class.st index d82bbc0..ff341c3 100644 --- a/packages/DomainCode-Parser/DCEditTest.class.st +++ b/packages/DomainCode-Parser/DCEditTest.class.st @@ -4,6 +4,18 @@ Class { #category : #'DomainCode-Parser' } +{ #category : #'as yet unclassified' } +DCEditTest >> testAcceptJS [ + + + | src editor | + src := 'function() {}'. + editor := self editorFor: (DCBlock parseBlock: src first asString language: SBJavascript). + src allButFirst + do: [:char | editor handle: (self keyboardEvent: char)] + displayingProgress: 'a' +] + { #category : #'as yet unclassified' } DCEditTest >> testDeleteEmptyLine [ diff --git a/packages/DomainCode-Parser/DCText.class.st b/packages/DomainCode-Parser/DCText.class.st index 8006d70..1242509 100644 --- a/packages/DomainCode-Parser/DCText.class.st +++ b/packages/DomainCode-Parser/DCText.class.st @@ -15,6 +15,12 @@ DCText >> alias [ ^ nil ] +{ #category : #'as yet unclassified' } +DCText >> allParentsUpTo: aBlock [ + + ^ {self}, (self containingSandblock allParentsUpTo: aBlock) +] + { #category : #'as yet unclassified' } DCText >> compatibleWithType: aSymbol [ @@ -27,6 +33,12 @@ DCText >> effectiveContents [ ^ self contents ] +{ #category : #'as yet unclassified' } +DCText >> ensureLayouted [ + + self owner ensureLayouted +] + { #category : #'as yet unclassified' } DCText >> field [