dc: small fixes

packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st

@@ -18,7 +18,7 @@ DCGreedySubtreeMatcher >> handleAmbiguousMappings: aCollection for: aMapping [
 	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]) do: [:mapping | (aMapping areBothUnmappedSrc: mapping first dest: mapping second) ifTrue: [aMapping addRecursiveMappingFrom: mapping first to: mapping second]]]
+		(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' }

packages/DomainCode-Diff/DCMappingComparator.class.st

@@ -62,13 +62,12 @@ DCMappingComparator >> compare: aMapping with: anotherMapping [
 
 { #category : #'as yet unclassified' }
 DCMappingComparator >> distanceAbsoluteCompare: aMapping with: anotherMapping [
-	"TODO compare the post-order position in the tree of the mapping, between src and dest"
 
-	^ SBToggledCode comment: '' active: 1 do: {
-		[0].
-		[
-			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]}
+	| 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
 ]
 
 { #category : #'as yet unclassified' }
@@ -95,17 +94,17 @@ DCMappingComparator >> initialize [
 DCMappingComparator >> longestCommonSubsequenceWith: aCollection and: anotherCollection [
 
 	| lengths x y indices |
-	lengths := Matrix rows: aCollection size + 1 columns: anotherCollection size + 1.
-	1 to: aCollection size + 1 do: [:i |
-		1 to: anotherCollection size + 1 do: [:j |
+	lengths := Matrix rows: aCollection size + 1 columns: anotherCollection size + 1 element: 0.
+	1 to: aCollection size do: [:i |
+		1 to: anotherCollection size do: [:j |
 			(aCollection at: i) type = (anotherCollection at: j) type
 				ifTrue: [lengths at: i + 1 at: j + 1 put: (lengths at: i at: j)]
 				ifFalse: [lengths at: i + 1 at: j + 1 put: ((lengths at: i + 1 at: j) max: (lengths at: i at: j + 1))]]].
 
 	indices := OrderedCollection new.
-	x := aCollection size.
-	y := anotherCollection size.
-	[x ~= 0 and: [y ~= 0]] whileTrue: [
+	x := aCollection size + 1.
+	y := anotherCollection size + 1.
+	[x > 1 and: [y > 1]] whileTrue: [
 		(lengths at: x at: y) = (lengths at: x - 1 at: y)
 			ifTrue: [x := x - 1]
 			ifFalse: [
@@ -142,7 +141,7 @@ DCMappingComparator >> numberOfCommonDescendantsIn: src and: dest [
 { #category : #'as yet unclassified' }
 DCMappingComparator >> numberOfCommonParentsIn: src and: dest [
 
-
+	^ (self longestCommonSubsequenceWith: (srcAncestors at: src) and: (destAncestors at: dest)) size
 ]
 
 { #category : #'as yet unclassified' }
@@ -158,12 +157,12 @@ DCMappingComparator >> similarityParentsCompare: aMapping with: anotherMapping [
 
 	s1 := self class
 		diceCoefficientCommon: (self numberOfCommonParentsIn: aMapping first and: aMapping second)
-		left: (srcAncestors at: aMapping first) recursiveSubmorphCount
-		right: (destAncestors at: aMapping second) recursiveSubmorphCount.
+		left: (srcAncestors at: aMapping first) size
+		right: (destAncestors at: aMapping second) size.
 	s2 := self class
 		diceCoefficientCommon: (self numberOfCommonParentsIn: anotherMapping first and: anotherMapping second)
-		left: (srcAncestors at: anotherMapping first) recursiveSubmorphCount
-		right: (destAncestors at: anotherMapping second) recursiveSubmorphCount.
+		left: (srcAncestors at: anotherMapping first) size
+		right: (destAncestors at: anotherMapping second) size.
 
 	^ (s2 - s1) sign
 ]
@@ -172,12 +171,13 @@ DCMappingComparator >> similarityParentsCompare: aMapping with: anotherMapping [
 DCMappingComparator >> similarityPositionInParentsCompare: aMapping with: anotherMapping [
 
 	| indicesInOwnerSubmorphs distance |
-	indicesInOwnerSubmorphs := [:src | | current |
-		indicesInOwnerSubmorphs := OrderedCollection new.
+	indicesInOwnerSubmorphs := [:src | | current indices |
+		indices := OrderedCollection new.
 		current := src.
 		[current notNil and: [current owner notNil]] whileTrue: [
-			indicesInOwnerSubmorphs add: current submorphIndex.
-			current := current owner]].
+			indices add: current submorphIndex.
+			current := current owner].
+		indices].
 	distance := [:mapping | | indicesVec1 indicesVec2 sum |
 		indicesVec1 := indicesInOwnerSubmorphs value: mapping first.
 		indicesVec2 := indicesInOwnerSubmorphs value: mapping second.
@@ -197,12 +197,12 @@ DCMappingComparator >> similaritySiblingsCompare: aMapping with: anotherMapping
 
 	s1 := self class
 		diceCoefficientCommon: (self numberOfCommonDescendantsIn: aMapping first owner and: aMapping second owner)
-		left: (srcDescendants at: aMapping first owner) recursiveSubmorphCount
-		right: (destDescendants at: aMapping second owner) recursiveSubmorphCount.
+		left: (srcDescendants at: aMapping first owner) size
+		right: (destDescendants at: aMapping second owner) size.
 	s2 := self class
 		diceCoefficientCommon: (self numberOfCommonDescendantsIn: anotherMapping first owner and: anotherMapping second owner)
-		left: (srcDescendants at: anotherMapping first owner) recursiveSubmorphCount
-		right: (destDescendants at: anotherMapping second owner) recursiveSubmorphCount.
+		left: (srcDescendants at: anotherMapping first owner) size
+		right: (destDescendants at: anotherMapping second owner) size.
 
 	^ (s2 - s1) sign
 ]

packages/DomainCode-Diff/DCMatchTest.class.st

@@ -9,11 +9,12 @@ DCMatchTest >> testSimple [
 
 	| src dest mappings |
 	Transcript clear.
-	src := DCBlock parseBlock: 'ab + 22' language: SBJavascript.
-	dest := DCBlock parseBlock: 'abc + 2' language: SBJavascript.
+	src := DCBlock parseBlock: 'a+1' language: SBJavascript.
+	dest := DCBlock parseBlock: '[a+1]' language: SBJavascript.
 	mappings := DCMappingStore new.
 	DCGreedySubtreeMatcher new matchFrom: src to: dest in: mappings.
 	DCGreedyBottomUpMatcher new matchFrom: src to: dest in: mappings.
+	self halt.
 	Transcript showln: (Array streamContents: [:stream |
 		DCChawatheScriptGenerator new
 			generateFrom: src

packages/DomainCode-Diff/DCMatcher.class.st

@@ -5,16 +5,15 @@ Class {
 }
 
 { #category : #'as yet unclassified' }
-DCMatcher >> matchFrom: src to: dest [
+DCMatcher >> matchFrom: src to: dest do: aBlock [
 
 	| mappings |
 	mappings := DCMappingStore new.
 	DCGreedySubtreeMatcher new matchFrom: src to: dest in: mappings.
 	DCGreedyBottomUpMatcher new matchFrom: src to: dest in: mappings.
-	Array streamContents: [:stream |
-		DCChawatheScriptGenerator new
-			generateFrom: src
-			to: dest
-			in: mappings
-			do: [:op :args | stream nextPut: {op. args}]]
+	DCChawatheScriptGenerator new
+		generateFrom: src
+		to: dest
+		in: mappings
+		do: aBlock
 ]

packages/DomainCode-Parser/DCBlock.class.st

@@ -65,6 +65,17 @@ DCBlock class >> parseBlock: aString language: aLanguage [
 			language: aLanguage]
 ]
 
+{ #category : #'as yet unclassified' }
+DCBlock >> absolutePositionOf: aMorph [
+
+	| n |
+	n := 0.
+	self allMorphsDo: [:m |
+		n := n + 1.
+		m = aMorph ifTrue: [^ n]].
+	^ self assert: false
+]
+
 { #category : #'as yet unclassified' }
 DCBlock >> alias [
 
@@ -469,6 +480,20 @@ DCBlock >> range: aRange [
 	range := aRange
 ]
 
+{ #category : #'as yet unclassified' }
+DCBlock >> replace: oldTree with: newTree [
+
+	^ SBToggledCode comment: '' active: 1 do: {
+		[
+			DCMatcher new matchFrom: oldTree to: newTree do: [:op :args | ].
+			oldTree].
+		[
+			self sandblockEditor do: (SBReplaceCommand new
+				target: oldTree replacer: newTree;
+				shouldMergeWithNext: true).
+			newTree]}
+]
+
 { #category : #'as yet unclassified' }
 DCBlock >> rootBlock [
 
@@ -650,12 +675,9 @@ DCBlock >> tryApplyChange: aClosure [
 		value: self activeTextMorph
 		value: (self activeTextMorph ifNotNil: [self activeTextMorph range start index + (oldCursorOffset - 1)])
 		value: [:newSource :newIndex |
-			newTree := (DCBlock parse: newSource language: self language)
+			newTree := self replace: oldTree with: ((DCBlock parse: newSource language: self language)
 				position: oldTree position;
-				width: oldTree width.
-			self sandblockEditor do: (SBReplaceCommand new
-				target: oldTree replacer: newTree;
-				shouldMergeWithNext: true).
+				width: oldTree width).
 			newIndex isNumber ifTrue: [newTree startInputAtSourceIndex: newIndex] ifFalse: [ | target |
 				target := newTree blockFor: newIndex.
 				target isTextMorph

packages/Sandblocks-TreeSitter/SBTSInputEdit.class.st

@@ -0,0 +1,18 @@
+Class {
+	#name : #SBTSInputEdit,
+	#superclass : #ExternalStructure,
+	#category : #'Sandblocks-TreeSitter-FFI'
+}
+
+{ #category : #'field definition' }
+SBTSInputEdit class >> fields [
+
+	^ #(
+		(startByte uint32_t)
+		(oldEndByte uint32_t)
+		(newEndByte uint32_t)
+		(startPoint SBTSPoint)
+		(oldEndPoint SBTSPoint)
+		(newEndPoint SBTSPoint)
+	)
+]

packages/Sandblocks-TreeSitter/SBTreeSitter.class.st

@@ -246,6 +246,13 @@ SBTreeSitter >> nodeChildCount: aNode [
 	^ self externalCallFailed
 ]
 
+{ #category : #ffi }
+SBTreeSitter >> nodeEdit: aNode edit: anEdit [
+
+	<apicall: void ts_node_edit (SBTSNode *, SBTSInputEdit *)>
+	^ self externalCallFailed
+]
+
 { #category : #ffi }
 SBTreeSitter >> nodeEndByte: aNode [
 
@@ -351,7 +358,7 @@ SBTreeSitter >> nodeType: aNode [
 	^ self externalCallFailed
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #helper }
 SBTreeSitter >> parseAsCursor: aString language: aSymbol do: aBlock [
 
 	| parser root tree cursor wasFreed |
@@ -440,7 +447,7 @@ SBTreeSitter >> printTree: cursor [
 					ifFalse: [visitedChildren := true]]] repeat
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #helper }
 SBTreeSitter >> printTreeFrom: aCursor depth: aNumber on: aStream [
 
 	aNumber timesRepeat: [aStream nextPut: Character tab].
@@ -573,6 +580,13 @@ SBTreeSitter >> textForNode: aNode [
 	^ (currentString copyFrom: (self nodeStartByte: aNode) + 1 to: (self nodeEndByte: aNode)) utf8Decoded
 ]
 
+{ #category : #ffi }
+SBTreeSitter >> treeEdit: aTree edit: anEdit [ 
+
+	<apicall: void 'ts_tree_edit' (void*, SBTSInputEdit*)>
+	^ self externalCallFailed
+]
+
 { #category : #ffi }
 SBTreeSitter >> treeRootNode: aTree [