From b1b42561584c538099e07a4c35568dbcce4a36f9 Mon Sep 17 00:00:00 2001 From: Tom Beckmann Date: Tue, 26 Sep 2023 22:42:55 +0200 Subject: [PATCH] dc: small fixes --- .../DCGreedySubtreeMatcher.class.st | 2 +- .../DCMappingComparator.class.st | 50 +++++++++---------- packages/DomainCode-Diff/DCMatchTest.class.st | 5 +- packages/DomainCode-Diff/DCMatcher.class.st | 13 +++-- packages/DomainCode-Parser/DCBlock.class.st | 32 ++++++++++-- .../SBTSInputEdit.class.st | 18 +++++++ .../SBTreeSitter.class.st | 18 ++++++- 7 files changed, 96 insertions(+), 42 deletions(-) create mode 100644 packages/Sandblocks-TreeSitter/SBTSInputEdit.class.st diff --git a/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st b/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st index 4e15cc3..c910647 100644 --- a/packages/DomainCode-Diff/DCGreedySubtreeMatcher.class.st +++ b/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' } diff --git a/packages/DomainCode-Diff/DCMappingComparator.class.st b/packages/DomainCode-Diff/DCMappingComparator.class.st index 1ebde7a..d3d44d4 100644 --- a/packages/DomainCode-Diff/DCMappingComparator.class.st +++ b/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 ] diff --git a/packages/DomainCode-Diff/DCMatchTest.class.st b/packages/DomainCode-Diff/DCMatchTest.class.st index 07b0204..14be7cb 100644 --- a/packages/DomainCode-Diff/DCMatchTest.class.st +++ b/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 diff --git a/packages/DomainCode-Diff/DCMatcher.class.st b/packages/DomainCode-Diff/DCMatcher.class.st index b54fd0e..fc1bbf1 100644 --- a/packages/DomainCode-Diff/DCMatcher.class.st +++ b/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 ] diff --git a/packages/DomainCode-Parser/DCBlock.class.st b/packages/DomainCode-Parser/DCBlock.class.st index 911274f..a028be3 100644 --- a/packages/DomainCode-Parser/DCBlock.class.st +++ b/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 diff --git a/packages/Sandblocks-TreeSitter/SBTSInputEdit.class.st b/packages/Sandblocks-TreeSitter/SBTSInputEdit.class.st new file mode 100644 index 0000000..036739c --- /dev/null +++ b/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) + ) +] diff --git a/packages/Sandblocks-TreeSitter/SBTreeSitter.class.st b/packages/Sandblocks-TreeSitter/SBTreeSitter.class.st index c4f918b..8810be4 100644 --- a/packages/Sandblocks-TreeSitter/SBTreeSitter.class.st +++ b/packages/Sandblocks-TreeSitter/SBTreeSitter.class.st @@ -246,6 +246,13 @@ SBTreeSitter >> nodeChildCount: aNode [ ^ self externalCallFailed ] +{ #category : #ffi } +SBTreeSitter >> nodeEdit: aNode edit: anEdit [ + + + ^ 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 [ + + + ^ self externalCallFailed +] + { #category : #ffi } SBTreeSitter >> treeRootNode: aTree [