1
1
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:
Timothy Clem 2017-07-07 14:43:32 -07:00
commit 61e0d8b83e
6 changed files with 106 additions and 12 deletions

@ -1 +1 @@
Subproject commit 07fb4ede133845f00661e890fa9475a9ec4d5d28
Subproject commit bbb3639e95e07c7b19268f54c4307fc4142288a6

View File

@ -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.

View File

@ -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.

View File

@ -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)

View File

@ -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

View File

@ -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)