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

Construct committed choices using the Alternative interface.

Browse Source
This commit is contained in:
Rob Rix 2017-04-26 11:29:24 -04:00
parent 447412be86
commit 2154e4a4ad
1 changed files with 5 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -64,10 +64,6 @@ children :: Assignment symbol a -> Assignment symbol a
children forEach = Children forEach `Then` return children forEach = Children forEach `Then` return
commit :: Assignment symbol a -> Assignment symbol a
commit assignment = assignment
-- | A rose tree. -- | A rose tree.
data Rose a = Rose { roseValue :: !a, roseChildren :: ![Rose a] } data Rose a = Rose { roseValue :: !a, roseChildren :: ![Rose a] }
deriving (Eq, Functor, Show) deriving (Eq, Functor, Show)
@ -138,9 +134,12 @@ data AssignmentState grammar = AssignmentState
} }
deriving (Eq, Show) deriving (Eq, Show)
instance Alternative (Assignment symbol) where instance Enum symbol => Alternative (Assignment (Node symbol)) where
empty = Empty `Then` return empty = Empty `Then` return
(<|>) = (wrap .) . Alt . commit a <|> b = case (a, b) of
(Symbol s1 `Then` _, Symbol s2 `Then` _) -> Choose (IntMap.fromListWith (flip const) [(fromEnum s1, a), (fromEnum s2, b)]) `Then` identity
(Choose choices `Then` continue, Symbol s `Then` _) -> Choose (IntMap.insertWith (flip const) (fromEnum s) b (fmap continue choices)) `Then` identity
_ -> wrap $ Alt a b
instance Show symbol => Show1 (AssignmentF (Node symbol)) where instance Show symbol => Show1 (AssignmentF (Node symbol)) where
liftShowsPrec sp sl d a = case a of liftShowsPrec sp sl d a = case a of