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

Cache the first set of productions on choices.

Browse Source
This commit is contained in:
Rob Rix 2017-08-04 15:34:55 -04:00
parent 86e18af4cd
commit 668f81d655
1 changed files with 19 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -105,6 +105,7 @@ import Data.Function
import Data.Functor.Classes import Data.Functor.Classes
import Data.Functor.Foldable as F hiding (Nil) import Data.Functor.Foldable as F hiding (Nil)
import Data.Ix (inRange) import Data.Ix (inRange)
import Data.List (union)
import Data.List.NonEmpty ((<|), NonEmpty(..), nonEmpty) import Data.List.NonEmpty ((<|), NonEmpty(..), nonEmpty)
import Data.Maybe import Data.Maybe
import Data.Ord (comparing) import Data.Ord (comparing)
@ -127,7 +128,7 @@ data AssignmentF ast grammar a where
Project :: HasCallStack => (forall x. Base ast x -> a) -> AssignmentF ast grammar a Project :: HasCallStack => (forall x. Base ast x -> a) -> AssignmentF ast grammar a
Source :: HasCallStack => AssignmentF ast grammar ByteString Source :: HasCallStack => AssignmentF ast grammar ByteString
Children :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar a Children :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar a
Choose :: HasCallStack => Array grammar (Maybe a) -> Maybe a -> AssignmentF ast grammar a Choose :: HasCallStack => [grammar] -> Array grammar (Maybe a) -> Maybe a -> AssignmentF ast grammar a
Many :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar [a] Many :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar [a]
Alt :: HasCallStack => NonEmpty a -> AssignmentF ast grammar a Alt :: HasCallStack => NonEmpty a -> AssignmentF ast grammar a
Throw :: HasCallStack => Error grammar -> AssignmentF ast grammar a Throw :: HasCallStack => Error grammar -> AssignmentF ast grammar a
@ -149,7 +150,7 @@ project projection = withFrozenCallStack $ Project projection `Then` return
-- --
-- Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. @many (symbol A *> b)@ is fine, but @many (symbol A)@ is not. -- Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. @many (symbol A *> b)@ is fine, but @many (symbol A)@ is not.
symbol :: (Ix grammar, HasCallStack) => grammar -> Assignment ast grammar (Record Location) symbol :: (Ix grammar, HasCallStack) => grammar -> Assignment ast grammar (Record Location)
symbol s = withFrozenCallStack $ Choose (array (s, s) [(s, Just ())]) Nothing `Then` (const location) symbol s = withFrozenCallStack $ Choose [s] (array (s, s) [(s, Just ())]) Nothing `Then` (const location)
-- | A rule to produce a node’s source as a ByteString. -- | A rule to produce a node’s source as a ByteString.
source :: HasCallStack => Assignment ast grammar ByteString source :: HasCallStack => Assignment ast grammar ByteString
@ -245,7 +246,7 @@ showPos path Info.Pos{..} = maybe (showParen True (showString "interactive")) sh
firstSet :: Ix grammar => Assignment ast grammar a -> [grammar] firstSet :: Ix grammar => Assignment ast grammar a -> [grammar]
firstSet = iterFreer (\ assignment _ -> case assignment of firstSet = iterFreer (\ assignment _ -> case assignment of
Choose choices _ -> catMaybes (uncurry (<$) <$> assocs choices) Choose symbols _ _ -> symbols
_ -> []) . ([] <$) _ -> []) . ([] <$)
@ -284,12 +285,12 @@ runAssignment toNode source = (\ assignment state -> disamb Left (Right . minimu
Children child -> do Children child -> do
(a, state') <- go child state { stateNodes = toList node } >>= requireExhaustive (a, state') <- go child state { stateNodes = toList node } >>= requireExhaustive
yield a (advance state' { stateNodes = stateNodes }) yield a (advance state' { stateNodes = stateNodes })
Choose choices _ | symbol <- nodeSymbol (toNode node), inRange (bounds choices) symbol, Just choice <- choices ! symbol -> yield choice state Choose _ choices _ | symbol <- nodeSymbol (toNode node), inRange (bounds choices) symbol, Just choice <- choices ! symbol -> yield choice state
_ -> anywhere (Just node) _ -> anywhere (Just node)
anywhere node = case assignment of anywhere node = case assignment of
Location -> yield (Info.Range stateOffset stateOffset :. Info.Span statePos statePos :. Nil) state Location -> yield (Info.Range stateOffset stateOffset :. Info.Span statePos statePos :. Nil) state
Choose _ (Just atEnd) -> yield atEnd state Choose _ _ (Just atEnd) -> yield atEnd state
Many rule -> fix (\ recur state -> (go rule state >>= \ (a, state') -> first (a:) <$> if state == state' then pure ([], state') else recur state') <> pure ([], state)) state >>= uncurry yield Many rule -> fix (\ recur state -> (go rule state >>= \ (a, state') -> first (a:) <$> if state == state' then pure ([], state') else recur state') <> pure ([], state)) state >>= uncurry yield
Alt as -> Some as >>= flip yield state Alt as -> Some as >>= flip yield state
Throw e -> None e Throw e -> None e
@ -334,7 +335,7 @@ makeState = State 0 (Info.Pos 1 1) 0
instance (Bounded grammar, Ix grammar) => Alternative (Assignment ast grammar) where instance (Bounded grammar, Ix grammar) => Alternative (Assignment ast grammar) where
empty :: HasCallStack => Assignment ast grammar a empty :: HasCallStack => Assignment ast grammar a
empty = Choose (listArray (maxBound, maxBound) [Nothing]) Nothing `Then` return empty = Choose [] (listArray (maxBound, maxBound) [Nothing]) Nothing `Then` return
(<|>) :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar a -> Assignment ast grammar a (<|>) :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar a -> Assignment ast grammar a
Return a <|> _ = Return a Return a <|> _ = Return a
(Throw err `Then` continue) <|> _ = Throw err `Then` continue (Throw err `Then` continue) <|> _ = Throw err `Then` continue
@ -344,21 +345,21 @@ instance (Bounded grammar, Ix grammar) => Alternative (Assignment ast grammar) w
(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 cl <- choices l, Just cr <- choices r = Choose (accumArray (\ a b -> liftA2 (<|>) a b <|> a <|> b) Nothing (unionBounds cl cr) (assocs cl <> assocs cr)) (atEnd l <|> atEnd r) `Then` id l <|> r | Just (sl, cl) <- choices l, Just (sr, cr) <- choices r = Choose (sl `union` sr) (accumArray (\ a b -> liftA2 (<|>) a b <|> a <|> b) Nothing (unionBounds cl cr) (assocs cl <> assocs cr)) (atEnd l <|> atEnd r) `Then` id
| otherwise = wrap (Alt (l :| [r])) | otherwise = wrap (Alt (l :| [r]))
where choices :: Assignment ast grammar a -> Maybe (Array grammar (Maybe (Assignment ast grammar a))) where choices :: Assignment ast grammar a -> Maybe ([grammar], Array grammar (Maybe (Assignment ast grammar a)))
choices (Location `Then` _) = Just empty choices (Location `Then` _) = Just ([], empty)
choices (Choose choices _ `Then` continue) = Just (fmap continue <$> choices) choices (Choose symbols choices _ `Then` continue) = Just (symbols, fmap continue <$> choices)
choices (Many rule `Then` continue) = fmap ((Many rule `Then` continue) <$) <$> choices rule choices (Many rule `Then` continue) = second (fmap ((Many rule `Then` continue) <$)) <$> choices rule
choices (Catch during handler `Then` continue) = fmap ((Catch during handler `Then` continue) <$) <$> choices during choices (Catch during handler `Then` continue) = second (fmap ((Catch during handler `Then` continue) <$)) <$> choices during
choices (Throw _ `Then` _) = Just empty choices (Throw _ `Then` _) = Just ([], empty)
choices (Return _) = Just empty choices (Return _) = Just ([], empty)
choices _ = Nothing choices _ = Nothing
empty = listArray (maxBound, maxBound) [Nothing] empty = listArray (maxBound, maxBound) [Nothing]
unionBounds a b = (min (uncurry min (bounds a)) (uncurry min (bounds b)), max (uncurry max (bounds a)) (uncurry max (bounds b))) unionBounds a b = (min (uncurry min (bounds a)) (uncurry min (bounds b)), max (uncurry max (bounds a)) (uncurry max (bounds b)))
atEnd :: Assignment ast grammar a -> Maybe (Assignment ast grammar a) atEnd :: Assignment ast grammar a -> Maybe (Assignment ast grammar a)
atEnd (Location `Then` continue) = Just (Location `Then` continue) atEnd (Location `Then` continue) = Just (Location `Then` continue)
atEnd (Choose _ atEnd `Then` continue) = continue <$> atEnd atEnd (Choose _ _ atEnd `Then` continue) = continue <$> atEnd
atEnd (Many rule `Then` continue) = Just (Many rule `Then` continue) atEnd (Many rule `Then` continue) = Just (Many rule `Then` continue)
atEnd (Throw err `Then` continue) = Just (Throw err `Then` continue) atEnd (Throw err `Then` continue) = Just (Throw err `Then` continue)
atEnd (Return a) = Just (Return a) atEnd (Return a) = Just (Return a)
@ -372,11 +373,13 @@ instance (Ix grammar, Show grammar) => Show1 (AssignmentF ast grammar) where
Project projection -> showsUnaryWith (const (const (showChar '_'))) "Project" d projection Project projection -> showsUnaryWith (const (const (showChar '_'))) "Project" d projection
Source -> showString "Source" . showChar ' ' . sp d "" Source -> showString "Source" . showChar ' ' . sp d ""
Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a
Choose choices atEnd -> showsBinaryWith (liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl)) (liftShowsPrec sp sl) "Choose" d (catMaybes (uncurry (fmap . (,)) <$> assocs choices)) atEnd Choose symbols choices atEnd -> showsTernaryWith showsPrec (const (liftShowList sp sl)) (liftShowsPrec sp sl) "Choose" d symbols ((choices !) <$> symbols) atEnd
Many a -> showsUnaryWith (liftShowsPrec (\ d a -> sp d [a]) (sl . pure)) "Many" d a Many a -> showsUnaryWith (liftShowsPrec (\ d a -> sp d [a]) (sl . pure)) "Many" d a
Alt as -> showsUnaryWith (const sl) "Alt" d (toList as) Alt as -> showsUnaryWith (const sl) "Alt" d (toList as)
Throw e -> showsUnaryWith showsPrec "Throw" d e Throw e -> showsUnaryWith showsPrec "Throw" d e
Catch during handler -> showsBinaryWith (liftShowsPrec sp sl) (const (const (showChar '_'))) "Catch" d during handler Catch during handler -> showsBinaryWith (liftShowsPrec sp sl) (const (const (showChar '_'))) "Catch" d during handler
where showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS
showsTernaryWith sp1 sp2 sp3 name d x y z = showParen (d > 10) $ showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z
instance MonadError (Error grammar) (Assignment ast grammar) where instance MonadError (Error grammar) (Assignment ast grammar) where
throwError :: HasCallStack => Error grammar -> Assignment ast grammar a throwError :: HasCallStack => Error grammar -> Assignment ast grammar a