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

Freeze the callstacks in <|>.

Browse Source
This commit is contained in:
Rob Rix 2017-08-03 21:10:08 -04:00
parent abaad4fc76
commit ffb01ff388
1 changed files with 2 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -337,8 +337,8 @@ instance Enum grammar => Alternative (Assignment ast grammar) where
(Source `Then` continueL) <|> (Source `Then` continueR) = Source `Then` uncurry (<|>) . (continueL &&& continueR)
(Alt ls `Then` continueL) <|> (Alt rs `Then` continueR) = Alt ((Left <$> ls) <> (Right <$> rs)) `Then` either continueL continueR
(Alt ls `Then` continueL) <|> r = Alt ((Left <$> ls) <> pure (Right r)) `Then` either continueL id
l <|> r | Just c <- (liftA2 (IntMap.unionWith (<|>)) `on` choices) l r = Choose c (atEnd l <|> atEnd r) `Then` id
| otherwise = wrap $ Alt (l :| [r])
l <|> r | Just c <- (liftA2 (IntMap.unionWith (<|>)) `on` choices) l r = withFrozenCallStack $ Choose c (atEnd l <|> atEnd r) `Then` id
| otherwise = withFrozenCallStack $ wrap (Alt (l :| [r]))
where choices :: Assignment ast grammar a -> Maybe (IntMap.IntMap (Assignment ast grammar a))
choices (Choose choices _ `Then` continue) = Just (continue <$> choices)
choices (Many rule `Then` continue) = ((Many rule `Then` continue) <$) <$> choices rule