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

Don’t reconstruct child ranges unnecessarily.

Browse Source
This commit is contained in:
Rob Rix 2016-03-08 23:21:02 -05:00
parent 1d54d34d77
commit b3db1e2bd0
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Alignment.hs
View File

@ -53,15 +53,15 @@ splitPatchByLines sources patch = zipWithDefaults makeRow (pure mempty) $ fmap (
splitAbstractedTerm :: (Info -> Syntax leaf outTerm -> outTerm) -> Source Char -> Info -> Syntax leaf [Line (outTerm, Range)] -> [Line (outTerm, Range)]
splitAbstractedTerm makeTerm source (Info range categories) syntax = case syntax of
Leaf a -> pure . ((`makeTerm` Leaf a) . (`Info` categories) &&& id) <$> actualLineRanges range source
Indexed children -> adjoinChildLines (Indexed . fmap (Prelude.fst . copoint)) (Identity <$> children)
Fixed children -> adjoinChildLines (Fixed . fmap (Prelude.fst . copoint)) (Identity <$> children)
Keyed children -> adjoinChildLines (Keyed . fmap Prelude.fst . Map.fromList) (Map.toList children)
Indexed children -> adjoinChildLines (Indexed . fmap copoint) (Identity <$> children)
Fixed children -> adjoinChildLines (Fixed . fmap copoint) (Identity <$> children)
Keyed children -> adjoinChildLines (Keyed . Map.fromList) (Map.toList children)
where adjoinChildLines constructor children = let (lines, next) = foldr childLines ([], end range) children in
fmap (wrapLineContents (makeBranchTerm (\ info -> makeTerm info . constructor) categories next)) . foldr (adjoinLinesBy (openRangePair source)) [] $
(pure . (,) Nothing <$> actualLineRanges (Range (start range) next) source) ++ lines
childLines child (lines, next) = let childRange = unionLineRangesFrom (rangeAt next) (copoint child) in
((fmap (flip (,) childRange . Just . (<$ child)) <$> copoint child)
((fmap (first (Just . (<$ child))) <$> copoint child)
++ (pure . (,) Nothing <$> actualLineRanges (Range (end childRange) next) source)
++ lines, start childRange)