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

Revert "Define eof in terms of state."

Browse Source 
This reverts commit b71a285f23f1a7112173f03a2041bebaae637940.
This commit is contained in:
Rob Rix 2017-08-16 12:48:39 -04:00
parent d861ff4329
commit 4daab99a09
1 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -131,6 +131,7 @@ type Assignment ast grammar = Freer (AssignmentF ast grammar)
data AssignmentF ast grammar a where
Get :: AssignmentF ast grammar (State ast grammar)
Put :: State ast grammar -> AssignmentF ast grammar ()
End :: HasCallStack => AssignmentF ast grammar ()
Source :: HasCallStack => AssignmentF ast grammar ByteString
Children :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar a
Choose :: HasCallStack => [grammar] -> IntMap.IntMap a -> AssignmentF ast grammar a
@ -264,6 +265,7 @@ runAssignment source = \ assignment state -> go assignment state >>= requireExha
anywhere node = case assignment of
Get -> yield state state
Put s -> yield () s
End -> requireExhaustive ((), state) >>= uncurry yield
Many rule -> fix (\ recur state -> (go rule state >>= \ (a, state') -> first (a:) <$> if state == state' then pure ([], state') else recur state') `catchError` const (pure ([], state))) state >>= uncurry yield
Alt as -> sconcat (flip yield state <$> as)
Throw e -> Left (fromMaybe (makeError node) e)
@ -350,7 +352,7 @@ instance (Eq grammar, Eq (ast (AST ast grammar))) => Alternative (Assignment ast
many :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar [a]
many a = Many a `Then` return
instance (Eq grammar, Symbol grammar, Eq (ast (AST ast grammar)), Show grammar, Show (ast (AST ast grammar))) => Parsing (Assignment ast grammar) where
instance (Eq grammar, Eq (ast (AST ast grammar)), Show grammar, Show (ast (AST ast grammar))) => Parsing (Assignment ast grammar) where
try :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar a
try = id
@ -361,9 +363,7 @@ instance (Eq grammar, Symbol grammar, Eq (ast (AST ast grammar)), Show grammar,
unexpected s = location >>= \ loc -> throwError (Error (Info.sourceSpan loc) [] (Just (Left s)))
eof :: HasCallStack => Assignment ast grammar ()
eof = do
state <- get
guard (not (null (stateNodes (skipTokens state))))
eof = withFrozenCallStack $ End `Then` return
notFollowedBy :: (HasCallStack, Show a) => Assignment ast grammar a -> Assignment ast grammar ()
notFollowedBy a = a *> unexpected (show a) <|> pure ()
@ -383,6 +383,7 @@ instance (Show grammar, Show (ast (AST ast grammar))) => Show1 (AssignmentF ast
liftShowsPrec sp sl d a = case a of
Get -> showString "Get"
Put s -> showsUnaryWith showsPrec "Put" d s
End -> showString "End" . showChar ' ' . sp d ()
Source -> showString "Source" . showChar ' ' . sp d ""
Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a
Choose symbols choices -> showsBinaryWith showsPrec (const (liftShowList sp sl)) "Choose" d symbols (IntMap.toList choices)