github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-09 00:56:32 +03:00
Code Issues Projects Releases Wiki Activity

Delete elements before the mapped element.

Browse Source
This commit is contained in:
Rob Rix 2017-10-23 16:19:35 -04:00
parent 2be26f291a
commit 39a1c46f6a
1 changed files with 3 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/RWS.hs
View File

@ -183,7 +183,7 @@ findNearestNeighbourTo' canCompare kdTreeA kdTreeB = go
where go _ [] [] = []
go _ as [] = This . (termIndex &&& term) <$> as
go _ [] bs = That . (termIndex &&& term) <$> bs
go previous unmappedA@(UnmappedTerm minA _ _ : restUnmappedA) (termB@(UnmappedTerm j _ b) : restUnmappedB) =
go previous unmappedA@(UnmappedTerm minA _ _ : _) (termB@(UnmappedTerm j _ b) : restUnmappedB) =
fromMaybe (That (j, b) : go previous unmappedA restUnmappedB) $ do
-- Look up the nearest unmapped term in `unmappedA`.
foundA@(UnmappedTerm i _ a) <- nearestUnmapped (\ a -> isNearAndComparableTo canCompare previous b a && termIndex a >= minA) kdTreeA termB
@ -192,7 +192,8 @@ findNearestNeighbourTo' canCompare kdTreeA kdTreeB = go
-- Return Nothing if their indices don't match
guard (j == j')
pure $!
These (i, a) (j, b) : go i restUnmappedA restUnmappedB
let (deleted, _ : restUnmappedA) = span ((< i) . termIndex) unmappedA in
(This . (termIndex &&& term) <$> deleted) <> (These (i, a) (j, b) : go i restUnmappedA restUnmappedB)
isNearAndComparableTo :: ComparabilityRelation syntax ann1 ann2 -> Int -> Term syntax ann2 -> UnmappedTerm syntax ann1 -> Bool
isNearAndComparableTo canCompare index term (UnmappedTerm k _ term') = inRange (succ index, index + defaultMoveBound) k && canCompareTerms canCompare term' term