1
1
mirror of https://github.com/github/semantic.git synced 2025-01-06 23:46:21 +03:00

Merge pull request #1117 from github/assigning-blame

Assigning blame
This commit is contained in:
Rick Winfrey 2017-05-16 10:15:33 -07:00 committed by GitHub
commit 9793809b7f
2 changed files with 53 additions and 44 deletions

View File

@ -1,4 +1,4 @@
{-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeFamilies #-} {-# LANGUAGE DataKinds, GADTs, InstanceSigs, ScopedTypeVariables, StandaloneDeriving, TypeFamilies #-}
-- | Assignment of AST onto some other structure (typically terms). -- | Assignment of AST onto some other structure (typically terms).
-- --
-- Parsing yields an AST represented as a Rose tree labelled with symbols in the languages grammar and source locations (byte Range and SourceSpan). An Assignment represents a (partial) map from AST nodes onto some other structure; in essence, its a parser that operates over trees. (For our purposes, this structure is typically Terms annotated with source locations.) Assignments are able to match based on symbol, sequence, and hierarchy; thus, in @x = y@, both @x@ and @y@ might have the same symbol, @Identifier@, the left can be assigned to a variable declaration, while the right can be assigned to a variable reference. -- Parsing yields an AST represented as a Rose tree labelled with symbols in the languages grammar and source locations (byte Range and SourceSpan). An Assignment represents a (partial) map from AST nodes onto some other structure; in essence, its a parser that operates over trees. (For our purposes, this structure is typically Terms annotated with source locations.) Assignments are able to match based on symbol, sequence, and hierarchy; thus, in @x = y@, both @x@ and @y@ might have the same symbol, @Identifier@, the left can be assigned to a variable declaration, while the right can be assigned to a variable reference.
@ -86,6 +86,7 @@ import qualified Data.IntMap.Lazy as IntMap
import Data.Ix (inRange) import Data.Ix (inRange)
import Data.List.NonEmpty (nonEmpty) import Data.List.NonEmpty (nonEmpty)
import Data.Record import Data.Record
import GHC.Stack
import qualified Info import qualified Info
import Prologue hiding (Alt, get, Location, state) import Prologue hiding (Alt, get, Location, state)
import Range (offsetRange) import Range (offsetRange)
@ -99,32 +100,32 @@ import Text.Show hiding (show)
type Assignment node = Freer (AssignmentF node) type Assignment node = Freer (AssignmentF node)
data AssignmentF node a where data AssignmentF node a where
Location :: AssignmentF node Location Location :: HasCallStack => AssignmentF node Location
Source :: AssignmentF symbol ByteString Source :: HasCallStack => AssignmentF symbol ByteString
Children :: Assignment symbol a -> AssignmentF symbol a Children :: HasCallStack => Assignment symbol a -> AssignmentF symbol a
Choose :: IntMap.IntMap a -> AssignmentF node a Choose :: HasCallStack => IntMap.IntMap a -> AssignmentF node a
Alt :: a -> a -> AssignmentF symbol a Alt :: HasCallStack => a -> a -> AssignmentF symbol a
Empty :: AssignmentF symbol a Empty :: HasCallStack => AssignmentF symbol a
-- | Zero-width production of the current location. -- | Zero-width production of the current location.
-- --
-- If assigning at the end of input or at the end of a list of children, the loccation will be returned as an empty Range and SourceSpan at the current offset. Otherwise, it will be the Range and SourceSpan of the current node. -- If assigning at the end of input or at the end of a list of children, the loccation will be returned as an empty Range and SourceSpan at the current offset. Otherwise, it will be the Range and SourceSpan of the current node.
location :: Assignment (Node grammar) Location location :: HasCallStack => Assignment (Node grammar) Location
location = Location `Then` return location = Location `Then` return
-- | Zero-width match of a node with the given symbol, producing the current nodes location. -- | Zero-width match of a node with the given symbol, producing the current nodes location.
-- --
-- Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (symbol A *> b)' is fine, but 'many (symbol A)' is not. -- Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (symbol A *> b)' is fine, but 'many (symbol A)' is not.
symbol :: (Enum symbol, Eq symbol) => symbol -> Assignment (Node symbol) Location symbol :: (Enum symbol, Eq symbol, HasCallStack) => symbol -> Assignment (Node symbol) Location
symbol s = Choose (IntMap.singleton (fromEnum s) ()) `Then` (const location) symbol s = withFrozenCallStack $ Choose (IntMap.singleton (fromEnum s) ()) `Then` (const location)
-- | A rule to produce a nodes source as a ByteString. -- | A rule to produce a nodes source as a ByteString.
source :: Assignment symbol ByteString source :: HasCallStack => Assignment symbol ByteString
source = Source `Then` return source = withFrozenCallStack $ Source `Then` return
-- | Match a node by applying an assignment to its children. -- | Match a node by applying an assignment to its children.
children :: Assignment symbol a -> Assignment symbol a children :: HasCallStack => Assignment symbol a -> Assignment symbol a
children forEach = Children forEach `Then` return children forEach = withFrozenCallStack $ Children forEach `Then` return
-- | A rose tree. -- | A rose tree.
@ -145,17 +146,22 @@ type AST grammar = Rose (Node grammar)
data Result symbol a = Result { resultErrors :: [Error symbol], resultValue :: Maybe a } data Result symbol a = Result { resultErrors :: [Error symbol], resultValue :: Maybe a }
deriving (Eq, Foldable, Functor, Traversable) deriving (Eq, Foldable, Functor, Traversable)
data Error symbol = Error data Error symbol where
{ errorPos :: Info.SourcePos Error
, errorExpected :: [symbol] :: HasCallStack
, errorActual :: Maybe symbol => { errorPos :: Info.SourcePos
} , errorExpected :: [symbol]
deriving (Eq, Show) , errorActual :: Maybe symbol
} -> Error symbol
deriving instance Eq symbol => Eq (Error symbol)
deriving instance Show symbol => Show (Error symbol)
-- | Pretty-print an Error with reference to the source where it occurred. -- | Pretty-print an Error with reference to the source where it occurred.
showError :: Show symbol => Source.Source -> Error symbol -> ShowS showError :: Show symbol => Source.Source -> Error symbol -> ShowS
showError source Error{..} showError source Error{..}
= showSourcePos errorPos . showString ": error: " . showExpectation . showChar '\n' = showSourcePos errorPos . showString ": error: " . showExpectation . showChar '\n'
. showString (prettyCallStack callStack) . showChar '\n'
. showString context -- actualLines results include line endings, so no newline here . showString context -- actualLines results include line endings, so no newline here
. showString (replicate (succ (Info.column errorPos + lineNumberDigits)) ' ') . showChar '^' . showChar '\n' . showString (replicate (succ (Info.column errorPos + lineNumberDigits)) ' ') . showChar '^' . showChar '\n'
where showExpectation = case (errorExpected, errorActual) of where showExpectation = case (errorExpected, errorActual) of
@ -177,10 +183,10 @@ showSourcePos :: Info.SourcePos -> ShowS
showSourcePos Info.SourcePos{..} = shows line . showChar ':' . shows column showSourcePos Info.SourcePos{..} = shows line . showChar ':' . shows column
-- | Run an assignment over an AST exhaustively. -- | 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 :: (Symbol grammar, Enum grammar, Eq grammar, Show grammar, HasCallStack) => Assignment (Node grammar) a -> Source.Source -> AST grammar -> Result grammar a
assign assignment source = fmap snd . assignAllFrom assignment . makeState source . pure 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 :: (Symbol grammar, Enum grammar, Eq grammar, Show grammar, HasCallStack) => Assignment (Node grammar) a -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
assignAllFrom assignment state = case runAssignment assignment state of assignAllFrom assignment state = case runAssignment assignment state of
Result es (Just (state, a)) -> case stateNodes (dropAnonymous state) of Result es (Just (state, a)) -> case stateNodes (dropAnonymous state) of
[] -> Result [] (Just (state, a)) [] -> Result [] (Just (state, a))
@ -188,7 +194,7 @@ assignAllFrom assignment state = case runAssignment assignment state of
r -> r r -> r
-- | Run an assignment of nodes in a grammar onto terms in a syntax. -- | Run an assignment of nodes in a grammar onto terms in a syntax.
runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a) runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, Show grammar, HasCallStack) => Assignment (Node grammar) a -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
runAssignment = iterFreer run . fmap (\ a state -> Result [] (Just (state, a))) runAssignment = iterFreer run . fmap (\ a state -> Result [] (Just (state, a)))
where run :: AssignmentF (Node grammar) x -> (x -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)) -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a) where run :: AssignmentF (Node grammar) x -> (x -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)) -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
run assignment yield initialState = case (assignment, stateNodes) of run assignment yield initialState = case (assignment, stateNodes) of
@ -236,7 +242,9 @@ makeState source nodes = AssignmentState 0 (Info.SourcePos 1 1) source nodes
-- Instances -- Instances
instance Enum symbol => Alternative (Assignment (Node symbol)) where instance Enum symbol => Alternative (Assignment (Node symbol)) where
empty :: HasCallStack => Assignment (Node symbol) a
empty = Empty `Then` return empty = Empty `Then` return
(<|>) :: HasCallStack => Assignment (Node symbol) a -> Assignment (Node symbol) a -> Assignment (Node symbol) a
a <|> b = case (a, b) of a <|> b = case (a, b) of
(_, Empty `Then` _) -> a (_, Empty `Then` _) -> a
(Empty `Then` _, _) -> b (Empty `Then` _, _) -> b

View File

@ -11,6 +11,7 @@ import qualified Data.Syntax.Declaration as Declaration
import qualified Data.Syntax.Expression as Expression import qualified Data.Syntax.Expression as Expression
import qualified Data.Syntax.Literal as Literal import qualified Data.Syntax.Literal as Literal
import qualified Data.Syntax.Statement as Statement import qualified Data.Syntax.Statement as Statement
import GHC.Stack
import Language.Haskell.TH hiding (location, Range(..)) import Language.Haskell.TH hiding (location, Range(..))
import Prologue hiding (for, get, Location, state, unless) import Prologue hiding (for, get, Location, state, unless)
import Term import Term
@ -54,30 +55,30 @@ mkSymbolDatatype (mkName "Grammar") tree_sitter_ruby
-- | Assignment from AST in Rubys grammar onto a program in Rubys syntax. -- | Assignment from AST in Rubys grammar onto a program in Rubys syntax.
assignment :: Assignment (Node Grammar) [Term Syntax Location] assignment :: HasCallStack => Assignment (Node Grammar) [Term Syntax Location]
assignment = symbol Program *> children (many declaration) assignment = symbol Program *> children (many declaration)
declaration :: Assignment (Node Grammar) (Term Syntax Location) declaration :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
declaration = comment <|> class' <|> method declaration = comment <|> class' <|> method
class' :: Assignment (Node Grammar) (Term Syntax Location) class' :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
class' = makeTerm <$> symbol Class <*> children (Declaration.Class <$> (constant <|> scopeResolution) <*> (superclass <|> pure []) <*> many declaration) class' = makeTerm <$> symbol Class <*> children (Declaration.Class <$> (constant <|> scopeResolution) <*> (superclass <|> pure []) <*> many declaration)
where superclass = pure <$ symbol Superclass <*> children constant where superclass = pure <$ symbol Superclass <*> children constant
scopeResolution = symbol ScopeResolution *> children (constant <|> identifier) scopeResolution = symbol ScopeResolution *> children (constant <|> identifier)
constant :: Assignment (Node Grammar) (Term Syntax Location) constant :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
constant = makeTerm <$> symbol Constant <*> (Syntax.Identifier <$> source) constant = makeTerm <$> symbol Constant <*> (Syntax.Identifier <$> source)
identifier :: Assignment (Node Grammar) (Term Syntax Location) identifier :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source) identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
method :: Assignment (Node Grammar) (Term Syntax Location) method :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
method = makeTerm <$> symbol Method <*> children (Declaration.Method <$> identifier <*> pure [] <*> statements) method = makeTerm <$> symbol Method <*> children (Declaration.Method <$> identifier <*> pure [] <*> statements)
statements :: Assignment (Node Grammar) (Term Syntax Location) statements :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
statements = makeTerm <$> location <*> many statement statements = makeTerm <$> location <*> many statement
statement :: Assignment (Node Grammar) (Term Syntax Location) statement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
statement = exit Statement.Return Return statement = exit Statement.Return Return
<|> exit Statement.Yield Yield <|> exit Statement.Yield Yield
<|> exit Statement.Break Break <|> exit Statement.Break Break
@ -91,36 +92,36 @@ statement = exit Statement.Return Return
<|> assignment' <|> assignment'
where exit construct sym = makeTerm <$> symbol sym <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children statement)) where exit construct sym = makeTerm <$> symbol sym <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children statement))
lvalue :: Assignment (Node Grammar) (Term Syntax Location) lvalue :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
lvalue = identifier lvalue = identifier
expression :: Assignment (Node Grammar) (Term Syntax Location) expression :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
expression = identifier <|> statement expression = identifier <|> statement
comment :: Assignment (Node Grammar) (Term Syntax Location) comment :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source) comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
if' :: Assignment (Node Grammar) (Term Syntax Location) if' :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
if' = ifElsif If if' = ifElsif If
<|> makeTerm <$> symbol IfModifier <*> children (flip Statement.If <$> statement <*> statement <*> (makeTerm <$> location <*> pure Syntax.Empty)) <|> makeTerm <$> symbol IfModifier <*> children (flip Statement.If <$> statement <*> statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
where ifElsif s = makeTerm <$> symbol s <*> children (Statement.If <$> statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (ifElsif Elsif <|> makeTerm <$> symbol Else <*> children (many statement)))) where ifElsif s = makeTerm <$> symbol s <*> children (Statement.If <$> statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (ifElsif Elsif <|> makeTerm <$> symbol Else <*> children (many statement))))
unless :: Assignment (Node Grammar) (Term Syntax Location) unless :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
unless = makeTerm <$> symbol Unless <*> children (Statement.If <$> invert statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (makeTerm <$> symbol Else <*> children (many statement)))) unless = makeTerm <$> symbol Unless <*> children (Statement.If <$> invert statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (makeTerm <$> symbol Else <*> children (many statement))))
<|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> invert statement <*> (makeTerm <$> location <*> pure Syntax.Empty)) <|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> invert statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
while :: Assignment (Node Grammar) (Term Syntax Location) while :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
while = makeTerm <$> symbol While <*> children (Statement.While <$> statement <*> statements) while = makeTerm <$> symbol While <*> children (Statement.While <$> statement <*> statements)
<|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> statement <*> statement) <|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> statement <*> statement)
until :: Assignment (Node Grammar) (Term Syntax Location) until :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
until = makeTerm <$> symbol Until <*> children (Statement.While <$> invert statement <*> statements) until = makeTerm <$> symbol Until <*> children (Statement.While <$> invert statement <*> statements)
<|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> statement <*> invert statement) <|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> statement <*> invert statement)
for :: Assignment (Node Grammar) (Term Syntax Location) for :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> identifier <*> statement <*> statements) for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> identifier <*> statement <*> statements)
assignment' :: Assignment (Node Grammar) (Term Syntax Location) assignment' :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
assignment' assignment'
= makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> lvalue <*> expression) = makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> lvalue <*> expression)
<|> makeTerm <$> symbol OperatorAssignment <*> children (lvalue >>= \ var -> Statement.Assignment var <$> <|> makeTerm <$> symbol OperatorAssignment <*> children (lvalue >>= \ var -> Statement.Assignment var <$>
@ -138,20 +139,20 @@ assignment'
<|> makeTerm <$> symbol AnonLAngleLAngleEqual <*> (Expression.LShift var <$> expression) <|> makeTerm <$> symbol AnonLAngleLAngleEqual <*> (Expression.LShift var <$> expression)
<|> makeTerm <$> symbol AnonCaretEqual <*> (Expression.BXOr var <$> expression))) <|> makeTerm <$> symbol AnonCaretEqual <*> (Expression.BXOr var <$> expression)))
literal :: Assignment (Node Grammar) (Term Syntax Location) literal :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
literal = makeTerm <$> symbol Language.Ruby.Syntax.True <*> (Literal.true <$ source) literal = makeTerm <$> symbol Language.Ruby.Syntax.True <*> (Literal.true <$ source)
<|> makeTerm <$> symbol Language.Ruby.Syntax.False <*> (Literal.false <$ source) <|> makeTerm <$> symbol Language.Ruby.Syntax.False <*> (Literal.false <$ source)
<|> makeTerm <$> symbol Language.Ruby.Syntax.Integer <*> (Literal.Integer <$> source) <|> makeTerm <$> symbol Language.Ruby.Syntax.Integer <*> (Literal.Integer <$> source)
<|> makeTerm <$> symbol Symbol <*> (Literal.Symbol <$> source) <|> makeTerm <$> symbol Symbol <*> (Literal.Symbol <$> source)
<|> makeTerm <$> symbol Range <*> children (Literal.Range <$> statement <*> statement) -- FIXME: represent the difference between .. and ... <|> makeTerm <$> symbol Range <*> children (Literal.Range <$> statement <*> statement) -- FIXME: represent the difference between .. and ...
invert :: InUnion fs Expression.Boolean => Assignment (Node grammar) (Term (Union fs) Location) -> Assignment (Node grammar) (Term (Union fs) Location) invert :: (InUnion fs Expression.Boolean, HasCallStack) => Assignment (Node grammar) (Term (Union fs) Location) -> Assignment (Node grammar) (Term (Union fs) Location)
invert term = makeTerm <$> location <*> fmap Expression.Not term invert term = makeTerm <$> location <*> fmap Expression.Not term
makeTerm :: InUnion fs f => a -> f (Term (Union fs) a) -> (Term (Union fs) a) makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term (Union fs) a) -> (Term (Union fs) a)
makeTerm a f = cofree $ a :< inj f makeTerm a f = cofree $ a :< inj f
emptyTerm :: Assignment (Node Grammar) (Term Syntax Location) emptyTerm :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
emptyTerm = makeTerm <$> location <*> pure Syntax.Empty emptyTerm = makeTerm <$> location <*> pure Syntax.Empty