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

Select a callstack to associate with committed choices.

Browse Source
This commit is contained in:
Rob Rix 2017-08-06 15:39:31 -04:00
parent 9579bc8aaa
commit 96d473f8f4
1 changed files with 11 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -300,8 +300,9 @@ instance Ix grammar => Alternative (Assignment ast grammar) where
(Alt ls `Then` continueL) <|> (Alt rs `Then` continueR) = Alt ((Left <$> ls) <> (Right <$> rs)) `Then` either 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 ((continueL <$> ls) <> pure r) `Then` id (Alt ls `Then` continueL) <|> r = Alt ((continueL <$> ls) <> pure r) `Then` id
l <|> (Alt rs `Then` continueR) = Alt (l <| (continueR <$> rs)) `Then` id l <|> (Alt rs `Then` continueR) = Alt (l <| (continueR <$> rs)) `Then` id
l <|> r | Just (sl, cl) <- choices l, Just (sr, cr) <- choices r = fromMaybe id (rewrapFor r) . fromMaybe id (rewrapFor l) $ Choose (sl `union` sr) (accumArray (\ a b -> liftA2 (<|>) a b <|> a <|> b) Nothing (unionBounds cl cr) (assocs cl <> assocs cr)) `Then` id l <|> r | Just (sl, cl) <- choices l, Just (sr, cr) <- choices r = fromMaybe id (rewrapFor r) . fromMaybe id (rewrapFor l) $
| otherwise = wrap (Alt (l :| [r])) withCallStack bestCallStack (Choose (sl `union` sr) (accumArray (\ a b -> liftA2 (<|>) a b <|> a <|> b) Nothing (unionBounds cl cr) (assocs cl <> assocs cr)) `Then` id)
| otherwise = withFrozenCallStack (Alt (l :| [r]) `Then` id)
where choices :: Assignment ast grammar a -> Maybe ([grammar], Array grammar (Maybe (Assignment ast grammar a))) where choices :: Assignment ast grammar a -> Maybe ([grammar], Array grammar (Maybe (Assignment ast grammar a)))
choices (Choose symbols choices `Then` continue) = Just (symbols, fmap continue <$> choices) choices (Choose symbols choices `Then` continue) = Just (symbols, fmap continue <$> choices)
choices (Many rule `Then` continue) = second (fmap ((Many rule `Then` continue) <$)) <$> choices rule choices (Many rule `Then` continue) = second (fmap ((Many rule `Then` continue) <$)) <$> choices rule
@ -316,6 +317,14 @@ instance Ix grammar => Alternative (Assignment ast grammar) where
rewrapFor (Catch _ handler `Then` continue) = Just (`catchError` (continue <=< handler)) rewrapFor (Catch _ handler `Then` continue) = Just (`catchError` (continue <=< handler))
rewrapFor _ = Nothing rewrapFor _ = Nothing
assignmentCallStack (Choose{} `Then` _) = Just callStack
assignmentCallStack (Many{} `Then` _) = Just callStack
assignmentCallStack (Catch{} `Then` _) = Just callStack
assignmentCallStack (Label{} `Then` _) = Just callStack
assignmentCallStack _ = Nothing
bestCallStack = fromMaybe callStack (assignmentCallStack r <|> assignmentCallStack l)
many :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar [a] many :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar [a]
many a = Many a `Then` return many a = Many a `Then` return