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

Inline the definition of mapContiguous.

Browse Source
This commit is contained in:
Rob Rix 2017-10-24 10:08:03 -04:00
parent 7692812a38
commit 354204107c
1 changed files with 6 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/RWS.hs
View File

@ -65,8 +65,13 @@ rws _ _ [] bs = That <$> bs
rws canCompare _ [a] [b] = if canCompareTerms canCompare a b then [These a b] else [That b, This a]
rws canCompare equivalent as bs
= ses (\ a b -> equivalent (term a) (term b)) (zipWith featurize [0..] as) (zipWith featurize [0..] bs)
& mapContiguous canCompare
& mapContiguous [] []
& fmap (bimap term term)
where mapContiguous as bs [] = findNearestNeighbourTo canCompare (reverse as) (reverse bs)
mapContiguous as bs (first : rest) = case first of
This a -> mapContiguous (a : as) bs rest
That b -> mapContiguous as (b : bs) rest
These _ _ -> findNearestNeighbourTo canCompare (reverse as) (reverse bs) <> (first : mapContiguous [] [] rest)
type Edit syntax ann1 ann2 = These (Term syntax ann1) (Term syntax ann2)
@ -124,18 +129,6 @@ defaultQ = 3
defaultMoveBound = 0
mapContiguous :: (Foldable syntax, Functor syntax, GAlign syntax)
=> ComparabilityRelation syntax ann1 ann2
-> [These (UnmappedTerm syntax ann1) (UnmappedTerm syntax ann2)]
-> [MappedDiff syntax ann1 ann2]
mapContiguous canCompare = go [] []
where go as bs [] = findNearestNeighbourTo canCompare (reverse as) (reverse bs)
go as bs (first : rest) = case first of
This a -> go (a : as) bs rest
That b -> go as (b : bs) rest
These _ _ -> findNearestNeighbourTo canCompare (reverse as) (reverse bs) <> (first : go [] [] rest)
featurize :: Functor syntax => Int -> Term syntax (Record (FeatureVector ': fields)) -> UnmappedTerm syntax (Record (FeatureVector ': fields))
featurize index term = UnmappedTerm index (rhead (extract term)) (eraseFeatureVector term)