mirror of
https://github.com/github/semantic.git
synced 2024-12-21 05:41:54 +03:00
Merge remote-tracking branch 'origin/master' into ruby-assignment
This commit is contained in:
commit
61e0d8b83e
2
languages/python/vendor/tree-sitter-python
vendored
2
languages/python/vendor/tree-sitter-python
vendored
@ -1 +1 @@
|
||||
Subproject commit 07fb4ede133845f00661e890fa9475a9ec4d5d28
|
||||
Subproject commit bbb3639e95e07c7b19268f54c4307fc4142288a6
|
@ -31,7 +31,7 @@ instance Eq1 Variable where liftEq = genericLiftEq
|
||||
instance Show1 Variable where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
data Class a = Class { classIdentifier :: !a, classSuperclasses :: ![a], classScope :: ![a] }
|
||||
data Class a = Class { classIdentifier :: !a, classSuperclasses :: ![a], classBody :: ![a] }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Class where liftEq = genericLiftEq
|
||||
@ -44,6 +44,14 @@ data Module a = Module { moduleIdentifier :: !a, moduleScope :: ![a] }
|
||||
instance Eq1 Module where liftEq = genericLiftEq
|
||||
instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
-- | A decorator in Python
|
||||
data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Decorator where liftEq = genericLiftEq
|
||||
instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
-- TODO: Generics, constraints.
|
||||
|
||||
|
||||
|
@ -37,6 +37,14 @@ data Pattern a = Pattern { pattern :: !a, patternBody :: !a }
|
||||
instance Eq1 Pattern where liftEq = genericLiftEq
|
||||
instance Show1 Pattern where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
data Let a = Let { letVariable :: !a, letValue :: !a, letBody :: !a }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Let where liftEq = genericLiftEq
|
||||
instance Show1 Let where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
-- Assignment
|
||||
|
||||
-- | Assignment to a variable or other lvalue.
|
||||
|
@ -10,6 +10,9 @@ import Prologue hiding (Product)
|
||||
data Annotation a = Annotation { annotationSubject :: !a, annotationType :: !a }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Annotation where liftEq = genericLiftEq
|
||||
instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
newtype Product a = Product { productElements :: [a] }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
|
@ -6,4 +6,5 @@ import Text.Parser.TreeSitter.Language
|
||||
import Text.Parser.TreeSitter.Python
|
||||
|
||||
-- | Statically-known rules corresponding to symbols in the grammar.
|
||||
-- v1 - bump this to regenerate
|
||||
mkSymbolDatatype (mkName "Grammar") tree_sitter_python
|
||||
|
@ -19,6 +19,7 @@ import qualified Data.Syntax.Declaration as Declaration
|
||||
import qualified Data.Syntax.Expression as Expression
|
||||
import qualified Data.Syntax.Literal as Literal
|
||||
import qualified Data.Syntax.Statement as Statement
|
||||
import qualified Data.Syntax.Type as Type
|
||||
import Data.Union
|
||||
import GHC.Generics
|
||||
import GHC.Stack
|
||||
@ -28,7 +29,9 @@ import qualified Term
|
||||
|
||||
type Syntax =
|
||||
'[ Comment.Comment
|
||||
, Declaration.Class
|
||||
, Declaration.Comprehension
|
||||
, Declaration.Decorator
|
||||
, Declaration.Function
|
||||
, Declaration.Import
|
||||
, Declaration.Variable
|
||||
@ -54,16 +57,24 @@ type Syntax =
|
||||
, Redirect
|
||||
, Statement.Assignment
|
||||
, Statement.Break
|
||||
, Statement.Catch
|
||||
, Statement.Continue
|
||||
, Statement.Else
|
||||
, Statement.Finally
|
||||
, Statement.ForEach
|
||||
, Statement.If
|
||||
, Statement.Let
|
||||
, Statement.NoOp
|
||||
, Statement.Return
|
||||
, Statement.Throw
|
||||
, Statement.Try
|
||||
, Statement.While
|
||||
, Statement.Yield
|
||||
, Language.Python.Syntax.Ellipsis
|
||||
, Syntax.Empty
|
||||
, Syntax.Error Error
|
||||
, Syntax.Identifier
|
||||
, Type.Annotation
|
||||
, []
|
||||
]
|
||||
|
||||
@ -90,7 +101,7 @@ assignment :: Assignment
|
||||
assignment = makeTerm <$> symbol Module <*> children (many declaration)
|
||||
|
||||
declaration :: Assignment
|
||||
declaration = handleError $ comment <|> statement <|> expression
|
||||
declaration = handleError $ classDefinition <|> comment <|> decoratedDefinition <|> functionDefinition <|> expression <|> statement
|
||||
|
||||
statement :: Assignment
|
||||
statement = assertStatement
|
||||
@ -99,8 +110,11 @@ statement = assertStatement
|
||||
<|> breakStatement
|
||||
<|> continueStatement
|
||||
<|> deleteStatement
|
||||
<|> exceptClause
|
||||
<|> execStatement
|
||||
<|> expressionStatement
|
||||
<|> finallyClause
|
||||
<|> forStatement
|
||||
<|> globalStatement
|
||||
<|> ifStatement
|
||||
<|> identifier
|
||||
@ -111,9 +125,12 @@ statement = assertStatement
|
||||
<|> printStatement
|
||||
<|> raiseStatement
|
||||
<|> returnStatement
|
||||
<|> tryStatement
|
||||
<|> whileStatement
|
||||
<|> withStatement
|
||||
|
||||
expressionStatement :: Assignment
|
||||
expressionStatement = symbol ExpressionStatement *> children expression
|
||||
expressionStatement = symbol ExpressionStatement *> children declaration
|
||||
|
||||
expression :: Assignment
|
||||
expression = await
|
||||
@ -126,7 +143,7 @@ expression = await
|
||||
<|> dottedName
|
||||
<|> ellipsis
|
||||
<|> expressionList
|
||||
<|> lambda
|
||||
<|> keywordArgument
|
||||
<|> keywordIdentifier
|
||||
<|> literal
|
||||
<|> memberAccess
|
||||
@ -134,8 +151,71 @@ expression = await
|
||||
<|> subscript
|
||||
<|> statement
|
||||
<|> tuple
|
||||
<|> type'
|
||||
<|> typedParameter
|
||||
<|> unaryOperator
|
||||
|
||||
decoratedDefinition :: Assignment
|
||||
decoratedDefinition = makeTerm <$> symbol DecoratedDefinition <*> (children $ do
|
||||
(a, b) <- (symbol Decorator *> (children ((,) <$> expression <*> (symbol ArgumentList *> children ((many expression) <|> (many emptyTerm))))))
|
||||
dec <- declaration
|
||||
pure (Declaration.Decorator a b dec))
|
||||
keywordArgument :: Assignment
|
||||
keywordArgument = makeTerm <$> symbol KeywordArgument <*> children (Declaration.Variable <$> expression <*> emptyTerm <*> expression)
|
||||
|
||||
withStatement :: Assignment
|
||||
withStatement = makeTerm <$> symbol WithStatement <*> (children $ do
|
||||
(value, variable) <- (symbol WithItem *> (children $ (,) <$> identifier <*> identifier))
|
||||
body <- expression
|
||||
pure (Statement.Let variable value body))
|
||||
|
||||
forStatement :: Assignment
|
||||
forStatement = symbol ForStatement >>= \ loc -> children (make loc <$> (makeTerm <$> symbol Variables <*> children (many expression)) <*> expressionList <*> (makeTerm <$> location <*> many expression) <*> (optional (makeTerm <$> symbol ElseClause <*> children (many declaration))))
|
||||
where
|
||||
make loc variables expressionList forBody forElseClause = case forElseClause of
|
||||
Nothing -> makeTerm loc (Statement.ForEach variables expressionList forBody)
|
||||
Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.ForEach variables expressionList forBody) a)
|
||||
|
||||
whileStatement :: Assignment
|
||||
whileStatement = symbol WhileStatement >>= \ loc -> children (make loc <$> expression <*> (makeTerm <$> location <*> many expression) <*> (optional (makeTerm <$> symbol ElseClause <*> children (many declaration))))
|
||||
where
|
||||
make loc whileCondition whileBody whileElseClause = case whileElseClause of
|
||||
Nothing -> makeTerm loc (Statement.While whileCondition whileBody)
|
||||
Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.While whileCondition whileBody) a)
|
||||
|
||||
tryStatement :: Assignment
|
||||
tryStatement = makeTerm <$> symbol TryStatement <*> children (Statement.Try <$> expression <*> (many (expression <|> elseClause)))
|
||||
where elseClause = makeTerm <$> symbol ElseClause <*> children (Statement.Else <$> emptyTerm <*> (makeTerm <$> location <*> (many expression)))
|
||||
|
||||
functionDefinition :: Assignment
|
||||
functionDefinition = (symbol FunctionDefinition >>= \ loc -> children (makeFunctionDeclaration loc <$> identifier <*> (symbol Parameters *> children (many expression)) <*> (optional (symbol Type *> children expression)) <*> (makeTerm <$> location <*> many declaration)))
|
||||
<|> (symbol AsyncFunctionDefinition >>= \ loc -> children (makeAsyncFunctionDeclaration loc <$> async' <*> identifier <*> (symbol Parameters *> children (many expression)) <*> (optional (symbol Type *> children expression)) <*> (makeTerm <$> location <*> many declaration)))
|
||||
<|> (symbol Lambda >>= \ loc -> children (makeFunctionDeclaration loc <$> (makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)) <*> ((symbol LambdaParameters *> children (many expression)) <|> (pure [])) <*> (optional (symbol Type *> children expression)) <*> (makeTerm <$> location <*> many declaration)))
|
||||
where
|
||||
makeFunctionDeclaration loc functionName' functionParameters ty functionBody = makeTerm loc $ Type.Annotation (makeTerm loc $ Declaration.Function functionName' functionParameters functionBody) (maybe (makeTerm loc Syntax.Empty) identity ty)
|
||||
makeAsyncFunctionDeclaration loc async' functionName' functionParameters ty functionBody = makeTerm loc $ Type.Annotation (makeTerm loc $ Type.Annotation (makeTerm loc $ Declaration.Function functionName' functionParameters functionBody) (maybe (makeTerm loc Syntax.Empty) identity ty)) async'
|
||||
|
||||
async' :: Assignment
|
||||
async' = makeTerm <$> symbol AnonAsync <*> (Syntax.Identifier <$> source)
|
||||
|
||||
classDefinition :: Assignment
|
||||
classDefinition = makeTerm <$> symbol ClassDefinition <*> children (Declaration.Class <$> identifier <*> argumentList <*> (many declaration))
|
||||
where argumentList = symbol ArgumentList *> children (many expression)
|
||||
<|> pure []
|
||||
|
||||
typedParameter :: Assignment
|
||||
typedParameter = makeTerm <$> symbol TypedParameter <*> children (Type.Annotation <$> identifier <*> type')
|
||||
|
||||
type' :: Assignment
|
||||
type' = symbol Type *> children expression
|
||||
|
||||
-- TODO: support As expressions
|
||||
exceptClause :: Assignment
|
||||
exceptClause = makeTerm <$> symbol ExceptClause <*> children (Statement.Catch <$> (makeTerm <$> location <*> (many identifier)) <*> (makeTerm <$> location <*> (many expression)))
|
||||
|
||||
finallyClause :: Assignment
|
||||
finallyClause = makeTerm <$> symbol FinallyClause <*> children (Statement.Finally <$> expression)
|
||||
|
||||
dottedName :: Assignment
|
||||
dottedName = makeTerm <$> symbol DottedName <*> children (Expression.ScopeResolution <$> many expression)
|
||||
|
||||
@ -289,7 +369,7 @@ await :: Assignment
|
||||
await = makeTerm <$> symbol Await <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier <$> source)) <*> many expression)
|
||||
|
||||
returnStatement :: Assignment
|
||||
returnStatement = makeTerm <$> symbol ReturnStatement <*> (Statement.Return <$> children expressionList)
|
||||
returnStatement = makeTerm <$> symbol ReturnStatement <*> children (Statement.Return <$> (expressionList <|> emptyTerm))
|
||||
|
||||
deleteStatement :: Assignment
|
||||
deleteStatement = makeTerm <$> symbol DeleteStatement <*> children (Expression.Call <$> deleteIdentifier <* symbol ExpressionList <*> children (many expression))
|
||||
@ -334,12 +414,6 @@ boolean = makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)
|
||||
none :: Assignment
|
||||
none = makeTerm <$> symbol None <*> (Literal.Null <$ source)
|
||||
|
||||
lambda :: Assignment
|
||||
lambda = makeTerm <$> symbol Lambda <*> children (Declaration.Function <$> lambdaIdentifier <*> lambdaParameters <*> lambdaBody)
|
||||
where lambdaIdentifier = makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)
|
||||
lambdaParameters = many identifier
|
||||
lambdaBody = expression
|
||||
|
||||
comprehension :: Assignment
|
||||
comprehension = makeTerm <$> symbol GeneratorExpression <*> children (comprehensionDeclaration expression)
|
||||
<|> makeTerm <$> symbol ListComprehension <*> children (comprehensionDeclaration expression)
|
||||
|
Loading…
Reference in New Issue
Block a user