github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-23 14:54:16 +03:00
Code Issues Projects Releases Wiki Activity

Rename the min index in A.

Browse Source
This commit is contained in:
Rob Rix 2017-10-24 00:00:33 -04:00
parent f6ea602cca
commit b2ef834746
1 changed files with 3 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/RWS.hs
View File

@ -86,16 +86,16 @@ findNearestNeighbourTo canCompare as bs = go as bs
go [] bs = That <$> bs go [] bs = That <$> bs
go [a] [b] | canCompareTerms canCompare (term a) (term b) = [These a b] go [a] [b] | canCompareTerms canCompare (term a) (term b) = [These a b]
| otherwise = [That b, This a] | otherwise = [That b, This a]
go unmappedA@(termA@(UnmappedTerm minA _ _) : _) (termB@(UnmappedTerm j _ b) : restUnmappedB) = go unmappedA@(termA@(UnmappedTerm i _ _) : _) (termB@(UnmappedTerm j _ b) : restUnmappedB) =
fromMaybe (That termB : go unmappedA restUnmappedB) $ do fromMaybe (That termB : go unmappedA restUnmappedB) $ do
-- Look up the nearest unmapped term in `unmappedA`. -- Look up the nearest unmapped term in `unmappedA`.
foundA@(UnmappedTerm i _ a) <- nearestUnmapped (isNearAndComparableTo canCompare minA b) kdTreeA termB foundA@(UnmappedTerm i' _ a) <- nearestUnmapped (isNearAndComparableTo canCompare i b) kdTreeA termB
-- Look up the nearest `foundA` in `unmappedB` -- Look up the nearest `foundA` in `unmappedB`
UnmappedTerm j' _ _ <- nearestUnmapped (isNearAndComparableTo (flip canCompare) j a) kdTreeB foundA UnmappedTerm j' _ _ <- nearestUnmapped (isNearAndComparableTo (flip canCompare) j a) kdTreeB foundA
-- Return Nothing if their indices don't match -- Return Nothing if their indices don't match
guard (j == j') guard (j == j')
pure $! pure $!
let (deleted, _ : restUnmappedA) = span ((< i) . termIndex) unmappedA in let (deleted, _ : restUnmappedA) = span ((< i') . termIndex) unmappedA in
(This <$> deleted) <> (These termA termB : go restUnmappedA restUnmappedB) (This <$> deleted) <> (These termA termB : go restUnmappedA restUnmappedB)
(kdTreeA, kdTreeB) = (toKdMap as, toKdMap bs) (kdTreeA, kdTreeB) = (toKdMap as, toKdMap bs)