github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-23 16:37:50 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into semantic-tags

Browse Source
This commit is contained in:
Rob Rix 2019-09-19 17:41:28 -04:00
commit 927d13b47c
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
10 changed files with 111 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
cabal.project
View File

@ -2,9 +2,6 @@ packages: . semantic-core semantic-python semantic-tags
jobs: $ncpus
package semantic
ghc-options: +RTS -A128m -n2m -RTS
source-repository-package
type: git
location: https://github.com/joshvera/proto3-suite.git

2
semantic-core/src/Data/Core/Parser.hs
View File

@ -4,6 +4,8 @@ module Data.Core.Parser
, core
, lit
, expr
, record
, comp
, lvalue
) where

4
semantic-python/semantic-python.cabal
View File

@ -23,6 +23,7 @@ common haskell
build-depends: base ^>=4.12
, fused-effects ^>= 0.5
, semantic-core ^>= 0.0
, text ^>= 1.2.3
, tree-sitter == 0.3.0.0
, tree-sitter-python == 0.4.0.0
@ -63,7 +64,7 @@ test-suite test
, containers ^>= 0.6
, directory ^>= 1.3.3
, exceptions ^>= 0.10.2
, filepath ^>= 1.4.2.1
, pathtype ^>= 0.8.1
, pretty-show ^>= 1.9.5
, process ^>= 1.6.5
, streaming ^>= 0.2.2
@ -71,6 +72,5 @@ test-suite test
, streaming-bytestring ^>= 0.1.6
, tasty ^>= 1.2.3
, tasty-hunit ^>= 0.10.0.2
, text ^>= 1.2.3
, trifecta >= 2 && <3
, unordered-containers ^>= 0.2.10

89
semantic-python/src/Language/Python/Core.hs
View File

@ -1,26 +1,34 @@
{-# LANGUAGE ConstraintKinds, DataKinds, DefaultSignatures, DeriveAnyClass, DeriveGeneric, DerivingStrategies,
DerivingVia, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, NamedFieldPuns,
OverloadedLists, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving, TypeApplications,
TypeOperators, UndecidableInstances #-}
DerivingVia, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving,
NamedFieldPuns, OverloadedLists, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving,
TypeApplications, TypeOperators, UndecidableInstances #-}
module Language.Python.Core
( compile
, SourcePath
) where
import Prelude hiding (fail)
import Control.Effect hiding ((:+:))
import Control.Effect.Reader
import Control.Monad.Fail
import Data.Core as Core
import Data.Foldable
import qualified Data.Loc
import Data.Name as Name
import Data.String (IsString)
import Data.Text (Text)
import GHC.Generics
import GHC.Records
import qualified Data.Loc
import qualified TreeSitter.Python.AST as Py
import TreeSitter.Span (Span)
import qualified TreeSitter.Span as TreeSitter
newtype SourcePath = SourcePath { rawPath :: Text }
deriving stock (Eq, Show)
deriving newtype IsString
-- We leave the representation of Core syntax abstract so that it's not
-- possible for us to 'cheat' by pattern-matching on or eliminating a
-- compiled term.
@ -32,21 +40,38 @@ type CoreSyntax sig t = ( Member Core sig
class Compile py where
-- FIXME: we should really try not to fail
compile :: (CoreSyntax sig t, MonadFail m) => py -> m (t Name)
compile :: ( CoreSyntax syn t
, Member (Reader SourcePath) sig
, Carrier sig m
, MonadFail m
)
=> py
-> m (t Name)
default compile :: (MonadFail m, Show py) => py -> m (t Name)
compile = defaultCompile
compileCC :: (CoreSyntax sig t, MonadFail m) => py -> m (t Name) -> m (t Name)
default compileCC :: (CoreSyntax sig t, MonadFail m) => py -> m (t Name) -> m (t Name)
compileCC :: ( CoreSyntax syn t
, Member (Reader SourcePath) sig
, Carrier sig m
, MonadFail m
)
=> py
-> m (t Name)
-> m (t Name)
compileCC py cc = (>>>) <$> compile py <*> cc
locate :: (HasField "ann" syntax Span, CoreSyntax sig t) => syntax -> t a -> t a
locate syn = Core.annAt (locFromTSSpan (getField @"ann" syn))
where
locFromTSSpan (TreeSitter.Span (TreeSitter.Pos a b) (TreeSitter.Pos c d))
= Data.Loc.Loc mempty (Data.Loc.Span (Data.Loc.Pos a b) (Data.Loc.Pos c d))
locate :: ( HasField "ann" syntax Span
, CoreSyntax syn t
, Member (Reader SourcePath) sig
, Carrier sig m
) => syntax -> t a -> m (t a)
locate syn item = do
fp <- asks @SourcePath rawPath
let locFromTSSpan (TreeSitter.Span (TreeSitter.Pos a b) (TreeSitter.Pos c d))
= Data.Loc.Loc fp (Data.Loc.Span (Data.Loc.Pos a b) (Data.Loc.Pos c d))
pure (Core.annAt (locFromTSSpan (getField @"ann" syn)) item)
-- | TODO: This is not right, it should be a reference to a Preluded
-- NoneType instance, but it will do for now.
@ -71,7 +96,7 @@ instance Compile (Py.Assignment Span) where
compile it@Py.Assignment { Py.left = Py.ExpressionList { Py.extraChildren = [lhs] }, Py.right = Just rhs } = do
target <- compile lhs
value <- compile rhs
pure . locate it $ target .= value
locate it $ target .= value
compile other = fail ("Unhandled assignment case: " <> show other)
instance Compile (Py.AugmentedAssignment Span)
@ -81,7 +106,7 @@ instance Compile (Py.BinaryOperator Span)
instance Compile (Py.Block Span) where
compile t = compileCC t (pure none)
compileCC it@Py.Block{ Py.extraChildren = body} cc = locate it <$> foldr compileCC cc body
compileCC it@Py.Block{ Py.extraChildren = body} cc = locate it =<< foldr compileCC cc body
instance Compile (Py.BooleanOperator Span)
instance Compile (Py.BreakStatement Span)
@ -106,15 +131,15 @@ deriving via CompileSum (Py.Expression Span) instance Compile (Py.Expression Spa
instance Compile (Py.ExpressionStatement Span) where
compile it@Py.ExpressionStatement { Py.extraChildren = children } = do
actions <- traverse compile children
pure . locate it $ do' (fmap (Nothing :<-) actions)
locate it $ do' (fmap (Nothing :<-) actions)
instance Compile (Py.ExpressionList Span) where
compile it@Py.ExpressionList { Py.extraChildren = exprs } = do
actions <- traverse compile exprs
pure . locate it $ do' (fmap (Nothing :<-) actions)
locate it $ do' (fmap (Nothing :<-) actions)
instance Compile (Py.False Span) where compile it = pure . locate it $ bool False
instance Compile (Py.False Span) where compile it = locate it $ bool False
instance Compile (Py.Float Span)
instance Compile (Py.ForStatement Span)
@ -127,7 +152,7 @@ instance Compile (Py.FunctionDefinition Span) where
} = do
parameters' <- traverse param parameters
body' <- compile body
pure . locate it $ (pure name .= lams parameters' body')
locate it $ (pure name .= lams parameters' body')
where param (Py.IdentifierParameter (Py.Identifier _pann pname)) = pure (named' pname)
param x = unimplemented x
unimplemented x = fail $ "unimplemented: " <> show x
@ -143,7 +168,7 @@ instance Compile (Py.IfStatement Span) where
compile stmt = compileCC stmt (pure none)
compileCC it@Py.IfStatement{ condition, consequence, alternative} cc =
locate it <$> (if' <$> compile condition <*> compileCC consequence cc <*> foldr clause cc alternative)
locate it =<< (if' <$> compile condition <*> compileCC consequence cc <*> foldr clause cc alternative)
where clause (Right Py.ElseClause{ body }) _ = compileCC body cc
clause (Left Py.ElifClause{ condition, consequence }) rest =
if' <$> compile condition <*> compileCC consequence cc <*> rest
@ -162,7 +187,7 @@ instance Compile (Py.Module Span) where
-- to top-level scope.
res <- traverse compile stmts
let names = concatMap toList res
pure . locate it . record $ zip names res
locate it . record $ zip names res
instance Compile (Py.NamedExpression Span)
instance Compile (Py.None Span)
@ -171,7 +196,7 @@ instance Compile (Py.NotOperator Span)
instance Compile (Py.ParenthesizedExpression Span)
instance Compile (Py.PassStatement Span) where
compile it@Py.PassStatement {} = pure . locate it $ Core.unit
compile it@Py.PassStatement {} = locate it $ Core.unit
deriving via CompileSum (Py.PrimaryExpression Span) instance Compile (Py.PrimaryExpression Span)
@ -179,8 +204,8 @@ instance Compile (Py.PrintStatement Span)
instance Compile (Py.ReturnStatement Span) where
compile it@Py.ReturnStatement { Py.extraChildren = vals } = case vals of
Nothing -> pure . locate it $ none
Just Py.ExpressionList { extraChildren = [val] } -> locate it <$> compile val
Nothing -> locate it $ none
Just Py.ExpressionList { extraChildren = [val] } -> compile val >>= locate it
Just Py.ExpressionList { extraChildren = vals } -> fail ("unimplemented: return statement returning " <> show (length vals) <> " values")
compileCC r _ = compile r
@ -195,12 +220,12 @@ deriving via CompileSum (Py.SimpleStatement Span) instance Compile (Py.SimpleSta
instance Compile (Py.String Span)
instance Compile (Py.Subscript Span)
instance Compile (Py.True Span) where compile it = pure . locate it $ bool True
instance Compile (Py.True Span) where compile it = locate it $ bool True
instance Compile (Py.TryStatement Span)
instance Compile (Py.Tuple Span) where
compile it@Py.Tuple { Py.extraChildren = [] } = pure . locate it $ Core.unit
compile it@Py.Tuple { Py.extraChildren = [] } = locate it $ Core.unit
compile it = fail ("Unimplemented: non-empty tuple " <> show it)
instance Compile (Py.UnaryOperator Span)
@ -209,9 +234,17 @@ instance Compile (Py.WithStatement Span)
instance Compile (Py.Yield Span)
class GCompileSum f where
gcompileSum :: (CoreSyntax sig t, MonadFail m) => f a -> m (t Name)
gcompileSum :: ( CoreSyntax syn t
, Member (Reader SourcePath) sig
, Carrier sig m
, MonadFail m
) => f a -> m (t Name)
gcompileCCSum :: (CoreSyntax sig t, MonadFail m) => f a -> m (t Name) -> m (t Name)
gcompileCCSum :: ( CoreSyntax syn t
, Member (Reader SourcePath) sig
, Carrier sig m
, MonadFail m
) => f a -> m (t Name) -> m (t Name)
instance GCompileSum f => GCompileSum (M1 D d f) where
gcompileSum (M1 f) = gcompileSum f

15
semantic-python/test/Directive.hs
View File

@ -5,6 +5,12 @@ module Directive ( Directive (..)
) where
import Control.Applicative
import Control.Monad
import Data.Name (Name)
import Data.Term (Term)
import Data.Core (Core)
import qualified Data.Core.Parser as Core.Parser
import qualified Data.Core.Pretty as Core.Pretty
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as ByteString
import Data.List.NonEmpty (NonEmpty)
@ -37,11 +43,13 @@ projects.
-}
data Directive = JQ ByteString -- | @# CHECK-JQ: expr@
| Tree (Term Core Name) -- | @# CHECK-TREE: core@
| Fails -- | @# CHECK-FAILS@ fails unless translation fails.
deriving (Eq, Show)
describe :: Directive -> String
describe Fails = "<expect failure>"
describe (Tree t) = Core.Pretty.showCore t
describe (JQ b) = ByteString.unpack b
fails :: Trifecta.Parser Directive
@ -52,8 +60,13 @@ jq = do
Trifecta.string "# CHECK-JQ: "
JQ . ByteString.pack <$> many (Trifecta.noneOf "\n")
tree :: Trifecta.Parser Directive
tree = do
void $ Trifecta.string "# CHECK-TREE: "
Tree <$> (Core.Parser.record <|> Core.Parser.comp)
directive :: Trifecta.Parser Directive
directive = fails <|> jq
directive = Trifecta.choice [ fails, jq, tree ]
toplevel :: Trifecta.Parser (NonEmpty Directive)
toplevel = directive `Trifecta.sepEndByNonEmpty` Trifecta.char '\n'

42
semantic-python/test/Test.hs
View File

@ -5,6 +5,7 @@ module Main (main) where
import qualified Analysis.Eval as Eval
import Control.Effect
import Control.Effect.Fail
import Control.Effect.Reader
import Control.Monad hiding (fail)
import Control.Monad.Catch
import Control.Monad.IO.Class
@ -23,6 +24,7 @@ import Data.Loc
import Data.Maybe
import Data.Name
import Data.Term
import Data.String (fromString)
import GHC.Stack
import qualified Language.Python.Core as Py
import Prelude hiding (fail)
@ -30,12 +32,14 @@ import Streaming
import qualified Streaming.Process
import System.Directory
import System.Exit
import System.FilePath
import qualified TreeSitter.Span as TS (Span)
import qualified TreeSitter.Python as TSP
import qualified TreeSitter.Python.AST as TSP
import qualified TreeSitter.Unmarshal as TS
import Text.Show.Pretty (ppShow)
import qualified System.Path as Path
import qualified System.Path.Directory as Path
import System.Path ((</>))
import qualified Test.Tasty as Tasty
import qualified Test.Tasty.HUnit as HUnit
@ -44,6 +48,7 @@ import Analysis.ScopeGraph
import qualified Directive
import Instances ()
assertJQExpressionSucceeds :: Show a => Directive.Directive -> a -> Term (Ann :+: Core) Name -> HUnit.Assertion
assertJQExpressionSucceeds directive tree core = do
bod <- case scopeGraph Eval.eval [File interactive core] of
@ -68,29 +73,38 @@ assertJQExpressionSucceeds directive tree core = do
catch @_ @Streaming.Process.ProcessExitedUnsuccessfully jqPipeline $ \err -> do
HUnit.assertFailure (unlines [errorMsg, dirMsg, jsonMsg, astMsg, treeMsg, treeMsg', show err])
fixtureTestTreeForFile :: HasCallStack => FilePath -> Tasty.TestTree
fixtureTestTreeForFile fp = HUnit.testCaseSteps fp $ \step -> withFrozenCallStack $ do
fileContents <- ByteString.readFile ("semantic-python/test/fixtures" </> fp)
fixtureTestTreeForFile :: HasCallStack => Path.RelFile -> Tasty.TestTree
fixtureTestTreeForFile fp = HUnit.testCaseSteps (Path.toString fp) $ \step -> withFrozenCallStack $ do
let fullPath = Path.relDir "semantic-python/test/fixtures" </> fp
fileContents <- ByteString.readFile (Path.toString fullPath)
directives <- case Directive.parseDirectives fileContents of
Right dir -> pure dir
Left err -> HUnit.assertFailure ("Directive parsing error: " <> err)
result <- TS.parseByteString TSP.tree_sitter_python fileContents
let coreResult = fmap (Control.Effect.run . runFail . Py.compile @(TSP.Module TS.Span) @_ @(Term (Ann :+: Core))) result
let coreResult = Control.Effect.run
. runFail
. runReader (fromString @Py.SourcePath . Path.toString $ fp)
. Py.compile @(TSP.Module TS.Span) @_ @(Term (Ann :+: Core))
<$> result
for_ directives $ \directive -> do
step (Directive.describe directive)
case coreResult of
Left err -> HUnit.assertFailure ("Parsing failed: " <> err)
Right (Left _) | directive == Directive.Fails -> pure ()
Right (Right _) | directive == Directive.Fails -> HUnit.assertFailure ("Expected translation to fail")
Right (Right item) -> assertJQExpressionSucceeds directive result item
Right (Left err) -> HUnit.assertFailure ("Compilation failed: " <> err)
case (coreResult, directive) of
(Right (Left _), Directive.Fails) -> pure ()
(Left err, _) -> HUnit.assertFailure ("Parsing failed: " <> err)
(Right (Left err), _) -> HUnit.assertFailure ("Compilation failed: " <> err)
(Right (Right _), Directive.Fails) -> HUnit.assertFailure ("Expected translation to fail")
(Right (Right item), Directive.JQ _) -> assertJQExpressionSucceeds directive result item
(Right (Right item), Directive.Tree t) -> let msg = "lhs = " <> showCore t <> "\n rhs " <> showCore item'
item' = stripAnnotations item
in HUnit.assertEqual msg t item' where
milestoneFixtures :: IO Tasty.TestTree
milestoneFixtures = do
files <- liftIO (listDirectory "semantic-python/test/fixtures")
let pythons = sort (filter ("py" `isExtensionOf`) files)
files <- liftIO (Path.filesInDir (Path.relDir "semantic-python/test/fixtures"))
let pythons = sort (filter (Path.hasExtension ".py") files)
pure $ Tasty.testGroup "Translation" (fmap fixtureTestTreeForFile pythons)
main :: IO ()

3
semantic-python/test/fixtures/1-03-empty-tuple.py vendored
View File

@ -1,2 +1,3 @@
# CHECK-JQ: .scope == {} and .tree.contents == []
# CHECK-JQ: .scope == {}
# CHECK-TREE: #record {}
()

2
semantic-python/test/fixtures/2-01-return-statement.py vendored
View File

@ -1,3 +1,3 @@
# CHECK-JQ: .tree.contents[0][1].contents[1].contents.value.value == []
# CHECK-TREE: #record { foo : foo = (\a -> a) }
def foo(a):
return a

2
semantic-python/test/fixtures/2-02-return-doesnt-translate.py vendored
View File

@ -1,4 +1,4 @@
# CHECK-JQ: .tree.contents[0][1].contents[1].contents.value.value == []
# CHECK-TREE: #record { foo : foo = (\a -> a) }
def foo(a):
return a

2
semantic.cabal
View File

@ -329,8 +329,6 @@ library
, tree-sitter-java == 0.2.0.0
if flag(release)
cpp-options: -DCOMPUTE_GIT_SHA
else
ghc-options: +RTS -A128m -n2m -RTS
executable semantic
import: haskell, dependencies, executable-flags