mirror of
https://github.com/github/semantic.git
synced 2025-01-03 13:02:37 +03:00
Merge branch 'master' into generalize-alignment-over-the-syntax-functor
This commit is contained in:
Rob Rix
GitHub
commit
4894a5b286
@ -73,9 +73,10 @@ module Data.Syntax.Assignment
|
||||
, Result(..)
|
||||
, Error(..)
|
||||
, showError
|
||||
, assignAll
|
||||
, assign
|
||||
, runAssignment
|
||||
, AssignmentState(..)
|
||||
, makeState
|
||||
) where
|
||||
|
||||
import Control.Monad.Free.Freer
|
||||
@ -175,9 +176,9 @@ showSymbols (h:t) = shows h . showString ", " . showSymbols t
|
||||
showSourcePos :: Info.SourcePos -> ShowS
|
||||
showSourcePos Info.SourcePos{..} = shows line . showChar ':' . shows column
|
||||
|
||||
-- | Run an assignment of nodes in a grammar onto terms in a syntax, discarding any unparsed nodes.
|
||||
assignAll :: (Symbol grammar, Enum grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> Source.Source -> [AST grammar] -> Result grammar a
|
||||
assignAll assignment = (fmap snd .) . (assignAllFrom assignment .) . AssignmentState 0 (Info.SourcePos 1 1)
|
||||
-- | Run an assignment over an AST exhaustively.
|
||||
assign :: (Symbol grammar, Enum grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> Source.Source -> AST grammar -> Result grammar a
|
||||
assign assignment source = fmap snd . assignAllFrom assignment . makeState source . pure
|
||||
|
||||
assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
|
||||
assignAllFrom assignment state = case runAssignment assignment state of
|
||||
@ -202,10 +203,13 @@ runAssignment = iterFreer run . fmap (\ a state -> Result [] (Just (state, a)))
|
||||
(Alt a b, _) -> yield a state <|> yield b state
|
||||
(_, []) -> Result [ Error statePos expectedSymbols Nothing ] Nothing
|
||||
(_, Rose (symbol :. _ :. nodeSpan :. Nil) _:_) -> Result [ Error (Info.spanStart nodeSpan) expectedSymbols (Just symbol) ] Nothing
|
||||
where state@AssignmentState{..} = dropAnonymous initialState
|
||||
where state@AssignmentState{..} = case assignment of
|
||||
Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous initialState
|
||||
_ -> initialState
|
||||
expectedSymbols = case assignment of
|
||||
Choose choices -> ((toEnum :: Int -> grammar) <$> IntMap.keys choices)
|
||||
Choose choices -> choiceSymbols choices
|
||||
_ -> []
|
||||
choiceSymbols choices = ((toEnum :: Int -> grammar) <$> IntMap.keys choices)
|
||||
|
||||
dropAnonymous :: Symbol grammar => AssignmentState grammar -> AssignmentState grammar
|
||||
dropAnonymous state = state { stateNodes = dropWhile ((/= Regular) . symbolType . rhead . roseValue) (stateNodes state) }
|
||||
@ -225,6 +229,12 @@ data AssignmentState grammar = AssignmentState
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
makeState :: Source.Source -> [AST grammar] -> AssignmentState grammar
|
||||
makeState source nodes = AssignmentState 0 (Info.SourcePos 1 1) source nodes
|
||||
|
||||
|
||||
-- Instances
|
||||
|
||||
instance Enum symbol => Alternative (Assignment (Node symbol)) where
|
||||
empty = Empty `Then` return
|
||||
a <|> b = case (a, b) of
|
||||
|
||||
@ -15,17 +15,37 @@ instance Eq1 Call where liftEq = genericLiftEq
|
||||
instance Show1 Call where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
-- | Unary boolean negation, like '!x' in many languages.
|
||||
data Not a = Not a
|
||||
-- | Binary arithmetic operators.
|
||||
data Arithmetic a
|
||||
= Plus a a
|
||||
| Minus a a
|
||||
| Times a a
|
||||
| DividedBy a a
|
||||
| Modulo a a
|
||||
| Power a a
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Not where liftEq = genericLiftEq
|
||||
instance Show1 Not where liftShowsPrec = genericLiftShowsPrec
|
||||
instance Eq1 Arithmetic where liftEq = genericLiftEq
|
||||
instance Show1 Arithmetic where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
-- | Boolean operators.
|
||||
data Boolean a
|
||||
= Or a a
|
||||
| And a a
|
||||
| Not a
|
||||
deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
|
||||
|
||||
-- | Binary addition.
|
||||
data Plus a = Plus a a
|
||||
instance Eq1 Boolean where liftEq = genericLiftEq
|
||||
instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
-- | Bitwise operators.
|
||||
data Bitwise a
|
||||
= BOr a a
|
||||
| BAnd a a
|
||||
| BXOr a a
|
||||
| LShift a a
|
||||
| RShift a a
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Plus where liftEq = genericLiftEq
|
||||
instance Show1 Plus where liftShowsPrec = genericLiftShowsPrec
|
||||
instance Eq1 Bitwise where liftEq = genericLiftEq
|
||||
instance Show1 Bitwise where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
@ -23,7 +23,9 @@ type Syntax' =
|
||||
'[Comment.Comment
|
||||
, Declaration.Class
|
||||
, Declaration.Method
|
||||
, Expression.Not
|
||||
, Expression.Arithmetic
|
||||
, Expression.Bitwise
|
||||
, Expression.Boolean
|
||||
, Literal.Array
|
||||
, Literal.Boolean
|
||||
, Literal.Hash
|
||||
@ -31,6 +33,7 @@ type Syntax' =
|
||||
, Literal.Range
|
||||
, Literal.String
|
||||
, Literal.Symbol
|
||||
, Statement.Assignment
|
||||
, Statement.Break
|
||||
, Statement.Continue
|
||||
, Statement.ForEach
|
||||
@ -82,8 +85,15 @@ statement = exit Statement.Return Return
|
||||
<|> until
|
||||
<|> for
|
||||
<|> literal
|
||||
<|> assignment'
|
||||
where exit construct sym = symbol sym *> term <*> children (construct <$> optional (symbol ArgumentList *> children statement))
|
||||
|
||||
lvalue :: Assignment (Node Grammar) (Term Syntax Location)
|
||||
lvalue = identifier
|
||||
|
||||
expression :: Assignment (Node Grammar) (Term Syntax Location)
|
||||
expression = identifier <|> statement
|
||||
|
||||
comment :: Assignment (Node Grammar) (Term Syntax Location)
|
||||
comment = leaf Comment Comment.Comment
|
||||
|
||||
@ -107,6 +117,24 @@ until = symbol Until *> term <*> children (Statement.While <$> (te
|
||||
for :: Assignment (Node Grammar) (Term Syntax Location)
|
||||
for = symbol For *> term <*> children (Statement.ForEach <$> identifier <*> statement <*> (term <*> many statement))
|
||||
|
||||
assignment' :: Assignment (Node Grammar) (Term Syntax Location)
|
||||
assignment'
|
||||
= symbol Assignment *> term <*> children (Statement.Assignment <$> lvalue <*> expression)
|
||||
<|> symbol OperatorAssignment *> term <*> children (lvalue >>= \ var -> Statement.Assignment var <$>
|
||||
(symbol AnonPlusEqual *> term <*> (Expression.Plus var <$> expression)
|
||||
<|> symbol AnonMinusEqual *> term <*> (Expression.Minus var <$> expression)
|
||||
<|> symbol AnonStarEqual *> term <*> (Expression.Times var <$> expression)
|
||||
<|> symbol AnonStarStarEqual *> term <*> (Expression.Power var <$> expression)
|
||||
<|> symbol AnonSlashEqual *> term <*> (Expression.DividedBy var <$> expression)
|
||||
<|> symbol AnonPipePipeEqual *> term <*> (Expression.And var <$> expression)
|
||||
<|> symbol AnonPipeEqual *> term <*> (Expression.BOr var <$> expression)
|
||||
<|> symbol AnonAmpersandAmpersandEqual *> term <*> (Expression.And var <$> expression)
|
||||
<|> symbol AnonAmpersandEqual *> term <*> (Expression.BAnd var <$> expression)
|
||||
<|> symbol AnonPercentEqual *> term <*> (Expression.Modulo var <$> expression)
|
||||
<|> symbol AnonRAngleRAngleEqual *> term <*> (Expression.RShift var <$> expression)
|
||||
<|> symbol AnonLAngleLAngleEqual *> term <*> (Expression.LShift var <$> expression)
|
||||
<|> symbol AnonCaretEqual *> term <*> (Expression.BXOr var <$> expression)))
|
||||
|
||||
literal :: Assignment (Node Grammar) (Term Syntax Location)
|
||||
literal = leaf Language.Ruby.Syntax.True (const Literal.true)
|
||||
<|> leaf Language.Ruby.Syntax.False (const Literal.false)
|
||||
|
||||
@ -2,6 +2,7 @@
|
||||
module TreeSitter
|
||||
( treeSitterParser
|
||||
, parseRubyToAST
|
||||
, parseRubyToTerm
|
||||
, defaultTermAssignment
|
||||
) where
|
||||
|
||||
@ -48,8 +49,8 @@ treeSitterParser language grammar blob = do
|
||||
|
||||
-- | Parse Ruby to AST. Intended for use in ghci, e.g.:
|
||||
--
|
||||
-- > Source.readAndTranscodeFile "/Users/rob/Desktop/test.rb" >>= parseRubyToAST >>= pure . uncurry (assignAll assignment) . second pure
|
||||
parseRubyToAST :: Source -> IO (Source, A.AST Ruby.Grammar)
|
||||
-- > Command.Files.readFile "/Users/rob/Desktop/test.rb" >>= parseRubyToAST . source
|
||||
parseRubyToAST :: Source -> IO (A.AST Ruby.Grammar)
|
||||
parseRubyToAST source = do
|
||||
document <- ts_document_new
|
||||
ts_document_set_language document Ruby.tree_sitter_ruby
|
||||
@ -63,7 +64,7 @@ parseRubyToAST source = do
|
||||
ast <- anaM toAST root
|
||||
|
||||
ts_document_free document
|
||||
pure (source, ast)
|
||||
pure ast
|
||||
where toAST :: Node -> IO (A.RoseF (A.Node Ruby.Grammar) Node)
|
||||
toAST node@Node{..} = do
|
||||
let count = fromIntegral nodeChildCount
|
||||
@ -76,6 +77,18 @@ parseRubyToAST source = do
|
||||
anaM g = a where a = pure . embed <=< traverse a <=< g
|
||||
|
||||
|
||||
-- | Parse Ruby to a list of Terms, printing any assignment errors to stdout. Intended for use in ghci, e.g.:
|
||||
--
|
||||
-- > Command.Files.readFile "/Users/rob/Desktop/test.rb" >>= parseRubyToTerm . source
|
||||
parseRubyToTerm :: Source -> IO (Maybe [Term Ruby.Syntax A.Location])
|
||||
parseRubyToTerm source = do
|
||||
ast <- parseRubyToAST source
|
||||
let A.Result errors value = A.assign Ruby.assignment source ast
|
||||
case value of
|
||||
Just a -> pure (Just a)
|
||||
_ -> traverse_ (putStrLn . ($ "") . A.showError source) errors >> pure Nothing
|
||||
|
||||
|
||||
-- | Return a parser for a tree sitter language & document.
|
||||
documentToTerm :: Language -> Ptr Document -> Parser (Syntax.Syntax Text) (Record DefaultFields)
|
||||
documentToTerm language document SourceBlob{..} = do
|
||||
|
||||
@ -14,79 +14,88 @@ spec :: Spec
|
||||
spec = do
|
||||
describe "Applicative" $ do
|
||||
it "matches in sequence" $
|
||||
runAssignment ((,) <$> red <*> red) (startingState "helloworld" [Rose (rec Red 0 5) [], Rose (rec Red 5 10) []]) `shouldBe` Result [] (Just (AssignmentState 10 (Info.SourcePos 1 11) (Source "") [], (Out "hello", Out "world")))
|
||||
runAssignment ((,) <$> red <*> red) (makeState "helloworld" [Rose (rec Red 0 5) [], Rose (rec Red 5 10) []]) `shouldBe` Result [] (Just (AssignmentState 10 (Info.SourcePos 1 11) "" [], (Out "hello", Out "world")))
|
||||
|
||||
describe "Alternative" $ do
|
||||
it "attempts multiple alternatives" $
|
||||
runAssignment (green <|> red) (startingState "hello" [Rose (rec Red 0 5) []]) `shouldBe` Result [] (Just (AssignmentState 5 (Info.SourcePos 1 6) (Source "") [], Out "hello"))
|
||||
runAssignment (green <|> red) (makeState "hello" [Rose (rec Red 0 5) []]) `shouldBe` Result [] (Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], Out "hello"))
|
||||
|
||||
it "matches repetitions" $
|
||||
let s = "colourless green ideas sleep furiously"
|
||||
w = words s
|
||||
(_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [Rose (rec Red i (i + B.length word)) []])) (0, []) w in
|
||||
resultValue (runAssignment (many red) (startingState s nodes)) `shouldBe` Just (AssignmentState (B.length s) (Info.SourcePos 1 (succ (B.length s))) (Source "") [], Out <$> w)
|
||||
resultValue (runAssignment (many red) (makeState (Source s) nodes)) `shouldBe` Just (AssignmentState (B.length s) (Info.SourcePos 1 (succ (B.length s))) "" [], Out <$> w)
|
||||
|
||||
it "matches one-or-more repetitions against one or more input nodes" $
|
||||
resultValue (runAssignment (some red) (startingState "hello" [Rose (rec Red 0 5) []])) `shouldBe` Just (AssignmentState 5 (Info.SourcePos 1 6) (Source "") [], [Out "hello"])
|
||||
resultValue (runAssignment (some red) (makeState "hello" [Rose (rec Red 0 5) []])) `shouldBe` Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], [Out "hello"])
|
||||
|
||||
describe "symbol" $ do
|
||||
it "matches nodes with the same symbol" $
|
||||
snd <$> runAssignment red (startingState "hello" [Rose (rec Red 0 5) []]) `shouldBe` Result [] (Just (Out "hello"))
|
||||
snd <$> runAssignment red (makeState "hello" [Rose (rec Red 0 5) []]) `shouldBe` Result [] (Just (Out "hello"))
|
||||
|
||||
it "does not advance past the current node" $
|
||||
fst <$> runAssignment (symbol Red) (startingState "hi" [ Rose (rec Red 0 2) [] ]) `shouldBe` Result [] (Just (AssignmentState 0 (Info.SourcePos 1 1) (Source "hi") [ Rose (rec Red 0 2) [] ]))
|
||||
let initialState = makeState "hi" [ Rose (rec Red 0 2) [] ] in
|
||||
fst <$> runAssignment (symbol Red) initialState `shouldBe` Result [] (Just initialState)
|
||||
|
||||
describe "source" $ do
|
||||
it "produces the node’s source" $
|
||||
assignAll source (Source "hi") [ Rose (rec Red 0 2) [] ] `shouldBe` Result [] (Just "hi")
|
||||
assign source "hi" (Rose (rec Red 0 2) []) `shouldBe` Result [] (Just "hi")
|
||||
|
||||
it "advances past the current node" $
|
||||
fst <$> runAssignment source (startingState "hi" [ Rose (rec Red 0 2) [] ]) `shouldBe` Result [] (Just (AssignmentState 2 (Info.SourcePos 1 3) (Source "") []))
|
||||
fst <$> runAssignment source (makeState "hi" [ Rose (rec Red 0 2) [] ]) `shouldBe` Result [] (Just (AssignmentState 2 (Info.SourcePos 1 3) "" []))
|
||||
|
||||
describe "children" $ do
|
||||
it "advances past the current node" $
|
||||
fst <$> runAssignment (children (pure (Out ""))) (startingState "a" [Rose (rec Red 0 1) []]) `shouldBe` Result [] (Just (AssignmentState 1 (Info.SourcePos 1 2) (Source "") []))
|
||||
fst <$> runAssignment (children (pure (Out ""))) (makeState "a" [Rose (rec Red 0 1) []]) `shouldBe` Result [] (Just (AssignmentState 1 (Info.SourcePos 1 2) "" []))
|
||||
|
||||
it "matches if its subrule matches" $
|
||||
() <$ runAssignment (children red) (startingState "a" [Rose (rec Blue 0 1) [Rose (rec Red 0 1) []]]) `shouldBe` Result [] (Just ())
|
||||
() <$ runAssignment (children red) (makeState "a" [Rose (rec Blue 0 1) [Rose (rec Red 0 1) []]]) `shouldBe` Result [] (Just ())
|
||||
|
||||
it "does not match if its subrule does not match" $
|
||||
(runAssignment (children red) (startingState "a" [Rose (rec Blue 0 1) [Rose (rec Green 0 1) []]])) `shouldBe` Result [ Error (Info.SourcePos 1 1) [Red] (Just Green) ] Nothing
|
||||
(runAssignment (children red) (makeState "a" [Rose (rec Blue 0 1) [Rose (rec Green 0 1) []]])) `shouldBe` Result [ Error (Info.SourcePos 1 1) [Red] (Just Green) ] Nothing
|
||||
|
||||
it "matches nested children" $ do
|
||||
runAssignment
|
||||
(symbol Red *> children (symbol Green *> children (symbol Blue *> source)))
|
||||
(startingState "1" [ Rose (rec Red 0 1) [ Rose (rec Green 0 1) [ Rose (rec Blue 0 1) [] ] ] ])
|
||||
(makeState "1" [ Rose (rec Red 0 1) [ Rose (rec Green 0 1) [ Rose (rec Blue 0 1) [] ] ] ])
|
||||
`shouldBe`
|
||||
Result [] (Just (AssignmentState 1 (Info.SourcePos 1 2) (Source "") [], "1"))
|
||||
Result [] (Just (AssignmentState 1 (Info.SourcePos 1 2) "" [], "1"))
|
||||
|
||||
it "continues after children" $ do
|
||||
resultValue (runAssignment
|
||||
(many (symbol Red *> children (symbol Green *> source)
|
||||
<|> symbol Blue *> source))
|
||||
(startingState "BC" [ Rose (rec Red 0 1) [ Rose (rec Green 0 1) [] ]
|
||||
, Rose (rec Blue 1 2) [] ]))
|
||||
(makeState "BC" [ Rose (rec Red 0 1) [ Rose (rec Green 0 1) [] ]
|
||||
, Rose (rec Blue 1 2) [] ]))
|
||||
`shouldBe`
|
||||
Just (AssignmentState 2 (Info.SourcePos 1 3) (Source "") [], ["B", "C"])
|
||||
Just (AssignmentState 2 (Info.SourcePos 1 3) "" [], ["B", "C"])
|
||||
|
||||
it "matches multiple nested children" $ do
|
||||
runAssignment
|
||||
(symbol Red *> children (many (symbol Green *> children (symbol Blue *> source))))
|
||||
(startingState "12" [ Rose (rec Red 0 2) [ Rose (rec Green 0 1) [ Rose (rec Blue 0 1) [] ]
|
||||
, Rose (rec Green 1 2) [ Rose (rec Blue 1 2) [] ] ] ])
|
||||
(makeState "12" [ Rose (rec Red 0 2) [ Rose (rec Green 0 1) [ Rose (rec Blue 0 1) [] ]
|
||||
, Rose (rec Green 1 2) [ Rose (rec Blue 1 2) [] ] ] ])
|
||||
`shouldBe`
|
||||
Result [] (Just (AssignmentState 2 (Info.SourcePos 1 3) (Source "") [], ["1", "2"]))
|
||||
Result [] (Just (AssignmentState 2 (Info.SourcePos 1 3) "" [], ["1", "2"]))
|
||||
|
||||
describe "runAssignment" $ do
|
||||
it "drops anonymous nodes before matching symbols" $
|
||||
runAssignment red (makeState "magenta red" [Rose (rec Magenta 0 7) [], Rose (rec Red 8 11) []]) `shouldBe` Result [] (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], Out "red"))
|
||||
|
||||
it "does not drop anonymous nodes after matching" $
|
||||
runAssignment red (makeState "red magenta" [Rose (rec Red 0 3) [], Rose (rec Magenta 4 11) []]) `shouldBe` Result [] (Just (AssignmentState 3 (Info.SourcePos 1 4) " magenta" [Rose (rec Magenta 4 11) []], Out "red"))
|
||||
|
||||
it "does not drop anonymous nodes when requested" $
|
||||
runAssignment ((,) <$> magenta <*> red) (makeState "magenta red" [Rose (rec Magenta 0 7) [], Rose (rec Red 8 11) []]) `shouldBe` Result [] (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], (Out "magenta", Out "red")))
|
||||
|
||||
rec :: symbol -> Int -> Int -> Record '[symbol, Range, SourceSpan]
|
||||
rec symbol start end = symbol :. Range start end :. Info.SourceSpan (Info.SourcePos 1 (succ start)) (Info.SourcePos 1 (succ end)) :. Nil
|
||||
|
||||
startingState :: ByteString -> [AST grammar] -> AssignmentState grammar
|
||||
startingState = AssignmentState 0 (Info.SourcePos 1 1) . Source
|
||||
|
||||
data Grammar = Red | Green | Blue
|
||||
data Grammar = Red | Green | Blue | Magenta
|
||||
deriving (Enum, Eq, Show)
|
||||
|
||||
instance Symbol Grammar where
|
||||
symbolType Magenta = Anonymous
|
||||
symbolType _ = Regular
|
||||
|
||||
data Out = Out ByteString
|
||||
@ -100,3 +109,6 @@ green = Out <$ symbol Green <*> source
|
||||
|
||||
blue :: Assignment (Node Grammar) Out
|
||||
blue = Out <$ symbol Blue <*> source
|
||||
|
||||
magenta :: Assignment (Node Grammar) Out
|
||||
magenta = Out <$ symbol Magenta <*> source
|
||||
|
||||
Loading…
Reference in New Issue
Block a user