Merge branch 'master' into less-taggable-codegen

semantic-python/semantic-python.cabal

@@ -64,6 +64,7 @@ test-suite test
                , directory ^>= 1.3.3
                , exceptions ^>= 0.10.2
                , filepath ^>= 1.4.2.1
+               , pretty-show ^>= 1.9.5
                , process ^>= 1.6.5
                , streaming ^>= 0.2.2
                , streaming-process ^>= 0.1

semantic-python/src/Language/Python/Core.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE DefaultSignatures, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, OverloadedStrings, OverloadedLists, ScopedTypeVariables, NamedFieldPuns, TypeOperators #-}
+{-# LANGUAGE DefaultSignatures, DeriveAnyClass, DerivingStrategies, DerivingVia, DisambiguateRecordFields,
+             FlexibleContexts, FlexibleInstances, NamedFieldPuns, OverloadedStrings, OverloadedLists, ScopedTypeVariables,
+             StandaloneDeriving, TypeOperators, UndecidableInstances, DeriveGeneric #-}
 module Language.Python.Core
 ( compile
 ) where
@@ -17,13 +19,35 @@ import           TreeSitter.Span (Span)
 class Compile py where
   -- FIXME: we should really try not to fail
   compile :: (Member Core sig, Carrier sig t, Foldable t, MonadFail m) => py -> m (t Name)
+
   default compile :: (MonadFail m, Show py) => py -> m (t Name)
   compile = defaultCompile
 
+  compileCC :: (Member Core sig, Carrier sig t, Foldable t, MonadFail m) => py -> m (t Name) -> m (t Name)
+
+  default compileCC :: ( Member Core sig
+                       , Carrier sig t
+                       , Foldable t
+                       , MonadFail m
+                       )
+                    => py -> m (t Name) -> m (t Name)
+  compileCC py cc = (>>>) <$> compile py <*> cc
+
+-- | TODO: This is not right, it should be a reference to a Preluded
+-- NoneType instance, but it will do for now.
+none :: (Member Core sig, Carrier sig t) => t Name
+none = unit
+
 defaultCompile :: (MonadFail m, Show py) => py -> m (t Name)
 defaultCompile t = fail $ "compilation unimplemented for " <> show t
 
-instance (Compile l, Compile r) => Compile (Either l r) where compile = compileSum
+newtype CompileSum py = CompileSum py
+
+instance (Generic py, GCompileSum (Rep py)) => Compile (CompileSum py) where
+  compile (CompileSum a) = gcompileSum . from $ a
+  compileCC (CompileSum a) cc = gcompileCCSum (from a) cc
+
+deriving via CompileSum (Either l r) instance (Compile l, Compile r) => Compile (Either l r)
 
 instance Compile (Py.AssertStatement Span)
 instance Compile (Py.Attribute Span)
@@ -38,14 +62,19 @@ instance Compile (Py.Assignment Span) where
 instance Compile (Py.AugmentedAssignment Span)
 instance Compile (Py.Await Span)
 instance Compile (Py.BinaryOperator Span)
-instance Compile (Py.Block Span)
+
+instance Compile (Py.Block Span) where
+  compile t = compileCC t (pure none)
+
+  compileCC Py.Block{ Py.extraChildren = body} cc = foldr compileCC cc body
+
 instance Compile (Py.BooleanOperator Span)
 instance Compile (Py.BreakStatement Span)
 instance Compile (Py.Call Span)
 instance Compile (Py.ClassDefinition Span)
 instance Compile (Py.ComparisonOperator Span)
 
-instance Compile (Py.CompoundStatement Span) where compile = compileSum
+deriving via CompileSum (Py.CompoundStatement Span) instance Compile (Py.CompoundStatement Span)
 
 instance Compile (Py.ConcatenatedString Span)
 instance Compile (Py.ConditionalExpression Span)
@@ -57,7 +86,7 @@ instance Compile (Py.DictionaryComprehension Span)
 instance Compile (Py.Ellipsis Span)
 instance Compile (Py.ExecStatement Span)
 
-instance Compile (Py.Expression Span) where compile = compileSum
+deriving via CompileSum (Py.Expression Span) instance Compile (Py.Expression Span)
 
 instance Compile (Py.ExpressionStatement Span) where
   compile Py.ExpressionStatement { Py.extraChildren = children } = do
@@ -96,11 +125,13 @@ instance Compile (Py.Identifier Span) where
   compile Py.Identifier { bytes } = pure (pure bytes)
 
 instance Compile (Py.IfStatement Span) where
-  compile Py.IfStatement{ condition, consequence, alternative } =
-    if' <$> compile condition <*> compile consequence <*> foldr clause (pure unit) alternative
-    where clause (Right Py.ElseClause{ body }) _ = compile body
+  compile stmt = compileCC stmt (pure none)
+
+  compileCC Py.IfStatement{ condition, consequence, alternative} cc =
+    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 <*> compile consequence <*> rest
+            if' <$> compile condition <*> compileCC consequence cc <*> rest
 
 
 instance Compile (Py.ImportFromStatement Span)
@@ -127,15 +158,24 @@ instance Compile (Py.ParenthesizedExpression Span)
 instance Compile (Py.PassStatement Span) where
   compile Py.PassStatement {} = pure Core.unit
 
-instance Compile (Py.PrimaryExpression Span) where compile = compileSum
+deriving via CompileSum (Py.PrimaryExpression Span) instance Compile (Py.PrimaryExpression Span)
 
 instance Compile (Py.PrintStatement Span)
-instance Compile (Py.ReturnStatement Span)
+
+instance Compile (Py.ReturnStatement Span) where
+  compile Py.ReturnStatement { Py.extraChildren = vals } = case vals of
+    Nothing -> pure none
+    Just Py.ExpressionList { extraChildren = [val] } -> compile val
+    Just Py.ExpressionList { extraChildren = vals  } -> fail ("unimplemented: return statement returning " <> show (length vals) <> " values")
+
+  compileCC r _ = compile r
+
+
 instance Compile (Py.RaiseStatement Span)
 instance Compile (Py.Set Span)
 instance Compile (Py.SetComprehension Span)
 
-instance Compile (Py.SimpleStatement Span) where compile = compileSum
+deriving via CompileSum (Py.SimpleStatement Span) instance Compile (Py.SimpleStatement Span)
 
 instance Compile (Py.String Span)
 instance Compile (Py.Subscript Span)
@@ -153,18 +193,22 @@ instance Compile (Py.WhileStatement Span)
 instance Compile (Py.WithStatement Span)
 instance Compile (Py.Yield Span)
 
-compileSum :: (Generic py, GCompileSum (Rep py), Member Core sig, Foldable t, Carrier sig t, MonadFail m) => py -> m (t Name)
-compileSum = gcompileSum . from
-
 class GCompileSum f where
   gcompileSum :: (Foldable t, Member Core sig, Carrier sig t, MonadFail m) => f a -> m (t Name)
 
+  gcompileCCSum :: (Foldable t, Member Core sig, Carrier sig t, MonadFail m) => f a -> m (t Name) -> m (t Name)
+
 instance GCompileSum f => GCompileSum (M1 D d f) where
   gcompileSum (M1 f) = gcompileSum f
+  gcompileCCSum (M1 f) = gcompileCCSum f
 
 instance (GCompileSum l, GCompileSum r) => GCompileSum (l :+: r) where
   gcompileSum (L1 l) = gcompileSum l
   gcompileSum (R1 r) = gcompileSum r
 
+  gcompileCCSum (L1 l) = gcompileCCSum l
+  gcompileCCSum (R1 r) = gcompileCCSum r
+
 instance Compile t => GCompileSum (M1 C c (M1 S s (K1 R t))) where
   gcompileSum (M1 (M1 (K1 t))) = compile t
+  gcompileCCSum (M1 (M1 (K1 t))) = compileCC t

semantic-python/test/Test.hs

@@ -35,6 +35,7 @@ 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 Test.Tasty as Tasty
 import qualified Test.Tasty.HUnit as HUnit
@@ -43,8 +44,8 @@ import           Analysis.ScopeGraph
 import qualified Directive
 import           Instances ()
 
-assertJQExpressionSucceeds :: Directive.Directive -> Term (Ann :+: Core) Name -> HUnit.Assertion
-assertJQExpressionSucceeds directive core = do
+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
     (heap, [File _ (Right result)]) -> pure $ Aeson.object
       [ "scope" Aeson..= heap
@@ -59,10 +60,13 @@ assertJQExpressionSucceeds directive core = do
       errorMsg = "jq(1) returned non-zero exit code"
       dirMsg    = "jq expression: " <> show directive
       jsonMsg   = "JSON value: " <> ByteString.Lazy.unpack (Aeson.encodePretty bod)
-      treeMsg   = "Core expr: " <> showCore (stripAnnotations core)
+      astMsg    = "AST (pretty): " <> ppShow tree
+      treeMsg   = "Core expr (pretty): " <> showCore (stripAnnotations core)
+      treeMsg'  = "Core expr (Show): " <> ppShow (stripAnnotations core)
+
 
   catch @_ @Streaming.Process.ProcessExitedUnsuccessfully jqPipeline $ \err -> do
-    HUnit.assertFailure (unlines [errorMsg, dirMsg, jsonMsg, treeMsg, show err])
+    HUnit.assertFailure (unlines [errorMsg, dirMsg, jsonMsg, astMsg, treeMsg, treeMsg', show err])
 
 fixtureTestTreeForFile :: HasCallStack => FilePath -> Tasty.TestTree
 fixtureTestTreeForFile fp = HUnit.testCaseSteps fp $ \step -> withFrozenCallStack $ do
@@ -79,7 +83,7 @@ fixtureTestTreeForFile fp = HUnit.testCaseSteps fp $ \step -> withFrozenCallStac
       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 item
+      Right (Right item) -> assertJQExpressionSucceeds directive result item
       Right (Left err)   -> HUnit.assertFailure ("Compilation failed: " <> err)
 
 

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

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

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

@@ -0,0 +1,6 @@
+# CHECK-JQ: .tree.contents[0][1].contents[1].contents.value == []
+
+def foo(a):
+    return a
+    a
+    ()

semantic-python/test/fixtures/2-03-return-in-if-statement.py

@@ -0,0 +1,7 @@
+# CHECK-JQ: .tree.contents[0][1].contents[1] | .tag == "Lam" and .contents.value.tag == "If"
+# CHECK-JQ: .tree.contents[0][1].contents[1].contents.value | .contents == [[], [], { "tag": "Unit" }]
+
+def foo(a):
+    if a: return a
+    return ()
+    ()