1
1
mirror of https://github.com/github/semantic.git synced 2025-01-02 20:41:38 +03:00

foldMap the symbols/choices/atEnd.

This commit is contained in:
Rob Rix 2017-08-31 11:33:09 -04:00
parent e6ccc0106b
commit 0eab75c320

View File

@ -181,7 +181,7 @@ advance = tracing Advance `Then` return
choice :: (Bounded grammar, Ix grammar, HasCallStack) => [Assignment ast grammar a] -> Assignment ast grammar a
choice alternatives = tracing (Choose symbols (IntMap.fromList choices) (wrap . tracing . Alt . toList <$> nonEmpty atEnd)) `Then` id
where (symbols, choices, atEnd) = foldr (<>) ([], [], []) (fmap toChoices alternatives)
where (symbols, choices, atEnd) = foldMap toChoices alternatives
toChoices :: Assignment ast grammar a -> ([grammar], [(Int, Assignment ast grammar a)], [Assignment ast grammar a])
toChoices rule = case rule of
Tracing _ (Choose s c a) `Then` continue -> (s, IntMap.toList (fmap continue c), toList (fmap continue a))