github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-30 10:27:45 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #1235 from github/remove-sourceState

Browse Source 
Remove sourceState from AssignmentState
This commit is contained in:
Timothy Clem 2017-07-21 09:28:11 -07:00 committed by GitHub
commit 87766719e9
2 changed files with 87 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -228,14 +228,28 @@ showPos :: Maybe FilePath -> Info.Pos -> ShowS
showPos path Info.Pos{..} = maybe (showParen True (showString "interactive")) showString path . showChar ':' . shows posLine . showChar ':' . shows posColumn
-- | Run an assignment over an AST exhaustively.
assign :: (HasField fields Info.Range, HasField fields Info.Span, HasField fields grammar, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => Assignment (Cofree f (Record fields)) grammar a -> Source.Source -> Cofree f (Record fields) -> Either (Error grammar) a
assign :: (HasField fields Info.Range, HasField fields Info.Span, HasField fields grammar, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack)
=> Assignment (Cofree f (Record fields)) grammar a
-> Source.Source
-> Cofree f (Record fields)
-> Either (Error grammar) a
assign = assignBy (\ (r :< _) -> Node (getField r) (getField r) (getField r))
assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> Source.Source -> ast -> Either (Error grammar) a
assignBy toNode assignment source = fmap fst . assignAllFrom toNode assignment . makeState source . pure
assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack)
=> (forall x. Base ast x -> Node grammar)
-> Assignment ast grammar a
-> Source.Source
-> ast
-> Either (Error grammar) a
assignBy toNode assignment source = fmap fst . assignAllFrom source toNode assignment . makeState . pure
assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)
assignAllFrom toNode assignment state = runAssignment toNode assignment state >>= go
assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack)
=> Source.Source
-> (forall x. Base ast x -> Node grammar)
-> Assignment ast grammar a
-> AssignmentState ast grammar
-> Either (Error grammar) (a, AssignmentState ast grammar)
assignAllFrom source toNode assignment state = runAssignment source toNode assignment state >>= go
where
go (a, state) = case stateNodes (dropAnonymous toNode state) of
[] -> Right (a, state)
@ -243,16 +257,21 @@ assignAllFrom toNode assignment state = runAssignment toNode assignment state >>
Left $ fromMaybe (Error spanStart (UnexpectedSymbol [] nodeSymbol)) (stateError state)
-- | Run an assignment of nodes in a grammar onto terms in a syntax.
runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)
runAssignment toNode = iterFreer run . fmap ((pure .) . (,))
runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack)
=> Source.Source
-> (forall x. Base ast x -> Node grammar)
-> Assignment ast grammar a
-> AssignmentState ast grammar
-> Either (Error grammar) (a, AssignmentState ast grammar)
runAssignment source toNode = iterFreer run . fmap ((pure .) . (,))
where run :: AssignmentF ast grammar x -> (x -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)) -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)
run assignment yield initialState = case (assignment, stateNodes state) of
(Location, node : _) -> yield (nodeLocation (toNode (F.project node))) state
(Location, []) -> yield (Info.Range (stateOffset state) (stateOffset state) :. Info.Span (statePos state) (statePos state) :. Nil) state
(Project projection, node : _) -> yield (projection (F.project node)) state
(Source, node : _) -> yield (Source.sourceBytes (Source.slice (nodeByteRange (toNode (F.project node))) (stateSource state))) (advanceState toNode state)
(Source, node : _) -> yield (Source.sourceBytes (Source.slice (nodeByteRange (toNode (F.project node))) source)) (advanceState toNode state)
(Children childAssignment, node : _) -> do
(a, state') <- assignAllFrom toNode childAssignment state { stateNodes = toList (F.project node) }
(a, state') <- assignAllFrom source toNode childAssignment state { stateNodes = toList (F.project node) }
yield a (advanceState toNode state' { stateNodes = stateNodes state })
(Choose choices, node : _) | Node symbol _ _ <- toNode (F.project node), Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state
(Many rule, _) -> uncurry yield (runMany rule state)
@ -274,7 +293,7 @@ runAssignment toNode = iterFreer run . fmap ((pure .) . (,))
_ -> []
choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices
runMany :: Assignment ast grammar v -> AssignmentState ast grammar -> ([v], AssignmentState ast grammar)
runMany rule state = case runAssignment toNode rule state of
runMany rule state = case runAssignment source toNode rule state of
Left err -> ([], state { stateError = Just err })
Right (a, state') | ((/=) `on` stateCounter) state state' ->
let (as, state'') = runMany rule state'
@ -285,11 +304,14 @@ runAssignment toNode = iterFreer run . fmap ((pure .) . (,))
dropAnonymous :: (Symbol grammar, Recursive ast) => (forall x. Base ast x -> Node grammar) -> AssignmentState ast grammar -> AssignmentState ast grammar
dropAnonymous toNode state = state { stateNodes = dropWhile ((/= Regular) . symbolType . nodeSymbol . toNode . F.project) (stateNodes state) }
-- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
-- | Advances the state past the current (head) node (if any), dropping it off
-- stateNodes & its corresponding bytes off of source, and updating stateOffset &
-- statePos to its end. Exhausted 'AssignmentState's (those without any
-- remaining nodes) are returned unchanged.
advanceState :: Recursive ast => (forall x. Base ast x -> Node grammar) -> AssignmentState ast grammar -> AssignmentState ast grammar
advanceState toNode state@AssignmentState{..}
| node : rest <- stateNodes
, Node{..} <- toNode (F.project node) = AssignmentState (Info.end nodeByteRange) (Info.spanEnd nodeSpan) stateError (succ stateCounter) stateSource rest
, Node{..} <- toNode (F.project node) = AssignmentState (Info.end nodeByteRange) (Info.spanEnd nodeSpan) stateError (succ stateCounter) rest
| otherwise = state
-- | State kept while running 'Assignment's.
@ -298,12 +320,11 @@ data AssignmentState ast grammar = AssignmentState
, statePos :: Info.Pos -- ^ The (1-indexed) line/column position in the Source thus far reached.
, stateError :: Maybe (Error grammar)
, stateCounter :: Int -- ^ Always incrementing counter that tracks how many nodes have been visited.
, stateSource :: Source.Source -- ^ The remaining Source. Equal to dropping 'stateOffset' bytes off the original input Source.
, stateNodes :: [ast] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
}
deriving (Eq, Show)
makeState :: Source.Source -> [ast] -> AssignmentState ast grammar
makeState :: [ast] -> AssignmentState ast grammar
makeState = AssignmentState 0 (Info.Pos 1 1) Nothing 0

92
test/Data/Syntax/Assignment/Spec.hs
View File

@ -13,13 +13,13 @@ spec :: Spec
spec = do
describe "Applicative" $
it "matches in sequence" $
fst <$> runAssignment headF ((,) <$> red <*> red) (makeState "helloworld" [node Red 0 5 [], node Red 5 10 []])
fst <$> runAssignment "helloworld" headF ((,) <$> red <*> red) (makeState [node Red 0 5 [], node Red 5 10 []])
`shouldBe`
Right (Out "hello", Out "world")
describe "Alternative" $ do
it "attempts multiple alternatives" $
fst <$> runAssignment headF (green <|> red) (makeState "hello" [node Red 0 5 []])
fst <$> runAssignment "hello" headF (green <|> red) (makeState [node Red 0 5 []])
`shouldBe`
Right (Out "hello")
@ -27,107 +27,107 @@ spec = do
let s = "colourless green ideas sleep furiously"
w = words s
(_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [node Red i (i + B.length word) []])) (0, []) w in
fst <$> runAssignment headF (many red) (makeState (fromBytes s) nodes)
fst <$> runAssignment (fromBytes s) headF (many red) (makeState nodes)
`shouldBe`
Right (Out <$> w)
it "matches one-or-more repetitions against one or more input nodes" $
fst <$> runAssignment headF (some red) (makeState "hello" [node Red 0 5 []])
fst <$> runAssignment "hello" headF (some red) (makeState [node Red 0 5 []])
`shouldBe`
Right [Out "hello"]
describe "symbol" $ do
it "matches nodes with the same symbol" $
fst <$> runAssignment headF red (makeState "hello" [node Red 0 5 []]) `shouldBe` Right (Out "hello")
fst <$> runAssignment "hello" headF red (makeState [node Red 0 5 []]) `shouldBe` Right (Out "hello")
it "does not advance past the current node" $
let initialState = makeState "hi" [ node Red 0 2 [] ] in
snd <$> runAssignment headF (symbol Red) initialState `shouldBe` Right initialState
let initialState = makeState [ node Red 0 2 [] ] in
snd <$> runAssignment "hi" headF (symbol Red) initialState `shouldBe` Right initialState
describe "without catchError" $ do
it "assignment returns UnexpectedSymbol" $
runAssignment headF
runAssignment "A" headF
red
(makeState "A" [node Green 0 1 []])
(makeState [node Green 0 1 []])
`shouldBe`
Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green))
it "assignment returns UnexpectedEndOfInput" $
runAssignment headF
runAssignment "A" headF
(symbol Green *> children (some red))
(makeState "A" [node Green 0 1 []])
(makeState [node Green 0 1 []])
`shouldBe`
Left (Error (Info.Pos 1 1) (UnexpectedEndOfInput [Red]))
describe "catchError" $ do
it "handler that always matches" $
fst <$> runAssignment headF
fst <$> runAssignment "A" headF
(red `catchError` (\ _ -> OutError <$ location <*> source))
(makeState "A" [node Green 0 1 []])
(makeState [node Green 0 1 []])
`shouldBe`
Right (OutError "A")
it "handler that matches" $
fst <$> runAssignment headF
fst <$> runAssignment "A" headF
(red `catchError` const green)
(makeState "A" [node Green 0 1 []])
(makeState [node Green 0 1 []])
`shouldBe`
Right (Out "A")
it "handler that doesn't match produces error" $
runAssignment headF
runAssignment "A" headF
(red `catchError` const blue)
(makeState "A" [node Green 0 1 []])
(makeState [node Green 0 1 []])
`shouldBe`
Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Blue] Green))
describe "in many" $ do
it "handler that always matches" $
fst <$> runAssignment headF
fst <$> runAssignment "PG" headF
(symbol Palette *> children (
many (red `catchError` (\ _ -> OutError <$ location <*> source))
))
(makeState "PG" [node Palette 0 1 [node Green 1 2 []]])
(makeState [node Palette 0 1 [node Green 1 2 []]])
`shouldBe`
Right [OutError "G"]
it "handler that matches" $
fst <$> runAssignment headF
fst <$> runAssignment "PG" headF
(symbol Palette *> children ( many (red `catchError` const green) ))
(makeState "PG" [node Palette 0 1 [node Green 1 2 []]])
(makeState [node Palette 0 1 [node Green 1 2 []]])
`shouldBe`
Right [Out "G"]
it "handler that doesn't match produces error" $
runAssignment headF
runAssignment "PG" headF
(symbol Palette *> children ( many (red `catchError` const blue) ))
(makeState "PG" [node Palette 0 1 [node Green 1 2 []]])
(makeState [node Palette 0 1 [node Green 1 2 []]])
`shouldBe`
Left (Error (Info.Pos 1 2) (UnexpectedSymbol [Blue] Green))
it "handler that always matches with apply consumes and then errors" $
runAssignment headF
runAssignment "PG" headF
(symbol Palette *> children (
(,) <$> many (red `catchError` (\ _ -> OutError <$ location <*> source)) <*> green
))
(makeState "PG" [node Palette 0 1 [node Green 1 2 []]])
(makeState [node Palette 0 1 [node Green 1 2 []]])
`shouldBe`
Left (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Green]))
it "handler that doesn't match with apply" $
fst <$> runAssignment headF
fst <$> runAssignment "PG" headF
(symbol Palette *> children (
(,) <$> many (red `catchError` const blue) <*> green
))
(makeState "PG" [node Palette 0 1 [node Green 1 2 []]])
(makeState [node Palette 0 1 [node Green 1 2 []]])
`shouldBe`
Right ([], Out "G")
describe "many" $ do
it "takes ones and only one zero width repetition" $
fst <$> runAssignment headF
fst <$> runAssignment "PGG" headF
(symbol Palette *> children ( many (green <|> pure (Out "always")) ))
(makeState "PGG" [node Palette 0 1 [node Green 1 2 [], node Green 2 3 []]])
(makeState [node Palette 0 1 [node Green 1 2 [], node Green 2 3 []]])
`shouldBe`
Right [Out "G", Out "G", Out "always"]
@ -136,55 +136,63 @@ spec = do
assignBy headF source "hi" (node Red 0 2 []) `shouldBe` Right "hi"
it "advances past the current node" $
snd <$> runAssignment headF source (makeState "hi" [ node Red 0 2 [] ]) `shouldBe` Right (AssignmentState 2 (Info.Pos 1 3) Nothing 1 "hi" [])
snd <$> runAssignment "hi" headF source (makeState [ node Red 0 2 [] ])
`shouldBe`
Right (AssignmentState 2 (Info.Pos 1 3) Nothing 1 [])
describe "children" $ do
it "advances past the current node" $
snd <$> runAssignment headF (children (pure (Out ""))) (makeState "a" [node Red 0 1 []]) `shouldBe` Right (AssignmentState 1 (Info.Pos 1 2) Nothing 1 "a" [])
snd <$> runAssignment "a" headF (children (pure (Out ""))) (makeState [node Red 0 1 []])
`shouldBe`
Right (AssignmentState 1 (Info.Pos 1 2) Nothing 1 [])
it "matches if its subrule matches" $
() <$ runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Red 0 1 []]]) `shouldBe` Right ()
() <$ runAssignment "a" headF (children red) (makeState [node Blue 0 1 [node Red 0 1 []]])
`shouldBe`
Right ()
it "does not match if its subrule does not match" $
runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Green 0 1 []]]) `shouldBe` Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green))
runAssignment "a" headF (children red) (makeState [node Blue 0 1 [node Green 0 1 []]])
`shouldBe`
Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green))
it "matches nested children" $
fst <$> runAssignment headF
fst <$> runAssignment "1" headF
(symbol Red *> children (symbol Green *> children (symbol Blue *> source)))
(makeState "1" [ node Red 0 1 [ node Green 0 1 [ node Blue 0 1 [] ] ] ])
(makeState [ node Red 0 1 [ node Green 0 1 [ node Blue 0 1 [] ] ] ])
`shouldBe`
Right "1"
it "continues after children" $
fst <$> runAssignment headF
fst <$> runAssignment "BC" headF
(many (symbol Red *> children (symbol Green *> source)
<|> symbol Blue *> source))
(makeState "BC" [ node Red 0 1 [ node Green 0 1 [] ]
(makeState [ node Red 0 1 [ node Green 0 1 [] ]
, node Blue 1 2 [] ])
`shouldBe`
Right ["B", "C"]
it "matches multiple nested children" $
fst <$> runAssignment headF
fst <$> runAssignment "12" headF
(symbol Red *> children (many (symbol Green *> children (symbol Blue *> source))))
(makeState "12" [ node Red 0 2 [ node Green 0 1 [ node Blue 0 1 [] ]
(makeState [ node Red 0 2 [ node Green 0 1 [ node Blue 0 1 [] ]
, node Green 1 2 [ node Blue 1 2 [] ] ] ])
`shouldBe`
Right ["1", "2"]
describe "runAssignment" $ do
it "drops anonymous nodes before matching symbols" $
fst <$> runAssignment headF red (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []])
fst <$> runAssignment "magenta red" headF red (makeState [node Magenta 0 7 [], node Red 8 11 []])
`shouldBe`
Right (Out "red")
it "does not drop anonymous nodes after matching" $
stateNodes . snd <$> runAssignment headF red (makeState "red magenta" [node Red 0 3 [], node Magenta 4 11 []])
stateNodes . snd <$> runAssignment "red magenta" headF red (makeState [node Red 0 3 [], node Magenta 4 11 []])
`shouldBe`
Right [node Magenta 4 11 []]
it "does not drop anonymous nodes when requested" $
fst <$> runAssignment headF ((,) <$> magenta <*> red) (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []])
fst <$> runAssignment "magenta red" headF ((,) <$> magenta <*> red) (makeState [node Magenta 0 7 [], node Red 8 11 []])
`shouldBe`
Right (Out "magenta", Out "red")