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

Always construct Alt nodes in <|>.

Browse Source
This commit is contained in:
Rob Rix 2017-08-31 14:53:36 -04:00
parent d655429fc0
commit 3cd2d2b4c2
1 changed files with 1 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Data/Syntax/Assignment.hs
View File

@ -365,10 +365,7 @@ instance (Bounded grammar, Eq (ast (AST ast grammar)), Ix grammar) => Alternativ
(Alt ls, Alt rs) -> alternate (Alt ((Left <$> ls) <> (Right <$> rs)))
(Alt ls, _) -> rebuild (Alt ((continueL <$> ls) <> pure r)) id
(_, Alt rs) -> rebuild (Alt (pure l <> (continueR <$> rs))) id
_ | Just (sl, cl) <- choices l
, Just (sr, cr) <- choices r
-> rebuild (Choose (sl `union` sr) (IntMap.unionWith (<|>) cl cr) (wrap . tracing . Alt . toList <$> nonEmpty (toList (atEnd l) <> toList (atEnd r)))) id
| otherwise -> rebuild (Alt [l, r]) id
_ -> rebuild (Alt [l, r]) id
where distribute :: (l ~ lr, r ~ lr) => AssignmentF ast grammar lr -> Assignment ast grammar a
distribute a = rebuild a (uncurry (<|>) . (continueL &&& continueR))
alternate :: AssignmentF ast grammar (Either l r) -> Assignment ast grammar a
@ -376,21 +373,6 @@ instance (Bounded grammar, Eq (ast (AST ast grammar)), Ix grammar) => Alternativ
rebuild :: AssignmentF ast grammar x -> (x -> Assignment ast grammar a) -> Assignment ast grammar a
rebuild a c = Tracing (callSiteL <|> callSiteR) a `Then` c
choices :: Assignment ast grammar z -> Maybe ([grammar], IntMap.IntMap (Assignment ast grammar z))
choices (Tracing _ (Choose symbols choices _) `Then` continue) = Just (symbols, continue <$> choices)
choices (Tracing _ (Jump symbols choices _) `Then` continue) = Just (symbols, IntMap.fromList (((id &&& (choices !)) <$> symbols) >>= \ (sym, a) -> (,) (toIndex sym) . continue <$> toList a))
choices (Tracing cs (Many rule) `Then` continue) = second ((Tracing cs (Many rule) `Then` continue) <$) <$> choices rule
choices (Tracing _ (Catch during _) `Then` continue) = second (fmap (>>= continue)) <$> choices during
choices (Tracing cs (Label rule label) `Then` continue) = second ((Tracing cs (Label rule label) `Then` continue) <$) <$> choices rule
choices _ = Nothing
atEnd :: Assignment ast grammar z -> Maybe (Assignment ast grammar z)
atEnd (Tracing _ (Choose _ _ atEnd) `Then` continue) = continue <$> atEnd
atEnd rule@(Tracing _ (Many _) `Then` _) = Just rule
atEnd rule@(Tracing _ (Catch _ _) `Then` _) = Just rule
atEnd rule@(Tracing _ (Label inner _) `Then` _) = rule <$ atEnd inner
atEnd _ = Nothing
many :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar [a]
many a = tracing (Many a) `Then` return