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

Frame the <|> rule in terms of the choices along each side.

Browse Source
This commit is contained in:
Rob Rix 2017-06-24 16:51:00 -04:00
parent 1bbb252738
commit 7df59da281
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -291,12 +291,12 @@ instance Enum grammar => Alternative (Assignment ast grammar) where
empty :: HasCallStack => Assignment ast grammar a
empty = Empty `Then` return
(<|>) :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar a -> Assignment ast grammar a
a <|> b = case (a, b) of
(Return a, _) -> pure a
(_, Empty `Then` _) -> a
(Empty `Then` _, _) -> b
(Choose choices1 `Then` continue1, Choose choices2 `Then` continue2) -> Choose (IntMap.union (fmap continue1 choices1) (fmap continue2 choices2)) `Then` identity
_ -> wrap $ Alt a b
Return a <|> _ = Return a
a <|> b | Just c <- (liftA2 (<>) `on` choices) a b = Choose c `Then` identity
| otherwise = wrap $ Alt a b
where choices (Choose choices `Then` continue) = Just (continue <$> choices)
choices (Empty `Then` _) = Just mempty
choices _ = Nothing
instance Show grammar => Show1 (AssignmentF ast grammar) where
liftShowsPrec sp sl d a = case a of