From 1cd10683238cf3b5b406661e85bbe259cdc9cea3 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 11 Sep 2019 11:43:11 -0400 Subject: [PATCH 01/12] Add test cases for translating early returns. --- semantic-python/test/fixtures/2-01-return-statement.py | 3 +++ .../test/fixtures/2-02-return-doesnt-translate.py | 6 ++++++ 2 files changed, 9 insertions(+) create mode 100644 semantic-python/test/fixtures/2-01-return-statement.py create mode 100644 semantic-python/test/fixtures/2-02-return-doesnt-translate.py diff --git a/semantic-python/test/fixtures/2-01-return-statement.py b/semantic-python/test/fixtures/2-01-return-statement.py new file mode 100644 index 000000000..196b60911 --- /dev/null +++ b/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 diff --git a/semantic-python/test/fixtures/2-02-return-doesnt-translate.py b/semantic-python/test/fixtures/2-02-return-doesnt-translate.py new file mode 100644 index 000000000..85fc047cd --- /dev/null +++ b/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 + () From 584e8721f129eb86eaf48d815656703c5b356eef Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 11 Sep 2019 11:45:21 -0400 Subject: [PATCH 02/12] Show more and prettier information in the failure dump. --- semantic-python/semantic-python.cabal | 1 + semantic-python/test/Test.hs | 14 +++++++++----- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index 74b2adf1b..d044b6bf2 100644 --- a/semantic-python/semantic-python.cabal +++ b/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 diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs index 9678e00d7..364f65a92 100644 --- a/semantic-python/test/Test.hs +++ b/semantic-python/test/Test.hs @@ -34,6 +34,7 @@ import System.FilePath 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 @@ -42,8 +43,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 @@ -58,10 +59,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 @@ -78,7 +82,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) From 33ea661bf6f190c5626a9f516a897d6c3725b03e Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 11 Sep 2019 11:45:43 -0400 Subject: [PATCH 03/12] Institute compileCC. --- semantic-python/src/Language/Python/Core.hs | 51 +++++++++++++++++++-- 1 file changed, 47 insertions(+), 4 deletions(-) diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index 44a9bc9c1..6eb933c29 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -16,13 +16,31 @@ import qualified TreeSitter.Python.AST as Py 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 +instance (Compile l, Compile r) => Compile (Either l r) where + compile = compileSum + compileCC = compileCCSum instance Compile Py.AssertStatement instance Compile Py.Attribute @@ -37,7 +55,12 @@ instance Compile Py.Assignment where instance Compile Py.AugmentedAssignment instance Compile Py.Await instance Compile Py.BinaryOperator -instance Compile Py.Block + +instance Compile Py.Block where + compile t = compileCC t (pure none) + + compileCC (Py.Block body) cc = foldr compileCC cc body + instance Compile Py.BooleanOperator instance Compile Py.BreakStatement instance Compile Py.Call @@ -132,12 +155,22 @@ instance Compile Py.PassStatement where instance Compile Py.PrimaryExpression where compile = compileSum instance Compile Py.PrintStatement -instance Compile Py.ReturnStatement + +instance Compile Py.ReturnStatement where + compile (Py.ReturnStatement []) = pure none + compile (Py.ReturnStatement [val]) = compile val + compile (Py.ReturnStatement vals) = fail ("unimplemented: return statement returning " <> show (length vals) <> " values") + + compileCC r _ = compile r + + instance Compile Py.RaiseStatement instance Compile Py.Set instance Compile Py.SetComprehension -instance Compile Py.SimpleStatement where compile = compileSum +instance Compile Py.SimpleStatement where + compile = compileSum + compileCC = compileCCSum instance Compile Py.String instance Compile Py.Subscript @@ -158,15 +191,25 @@ instance Compile Py.Yield compileSum :: (Generic py, GCompileSum (Rep py), Member Core sig, Foldable t, Carrier sig t, MonadFail m) => py -> m (t Name) compileSum = gcompileSum . from +compileCCSum :: (Generic py, GCompileSum (Rep py), Member Core sig, Foldable t, Carrier sig t, MonadFail m) => py -> m (t Name) -> m (t Name) +compileCCSum = gcompileCCSum . 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 From b3a222139096d979881238d6ff2b9b87028703bb Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 11 Sep 2019 11:48:06 -0400 Subject: [PATCH 04/12] Work around #195. --- semantic-python/src/Language/Python/Core.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index 6eb933c29..5477c2ca0 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -59,7 +59,8 @@ instance Compile Py.BinaryOperator instance Compile Py.Block where compile t = compileCC t (pure none) - compileCC (Py.Block body) cc = foldr compileCC cc body + -- BUG: working around https://github.com/tree-sitter/haskell-tree-sitter/issues/195 + compileCC (Py.Block body) cc = foldr compileCC cc (reverse body) instance Compile Py.BooleanOperator instance Compile Py.BreakStatement From 9728ef0199b046660cff7f3a544ce33efe34d41c Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 11 Sep 2019 12:21:24 -0400 Subject: [PATCH 05/12] Check that returns work within if-clauses. --- semantic-python/src/Language/Python/Core.hs | 10 +++++++++- .../test/fixtures/2-03-return-in-if-statement.py | 7 +++++++ 2 files changed, 16 insertions(+), 1 deletion(-) create mode 100644 semantic-python/test/fixtures/2-03-return-in-if-statement.py diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index 5477c2ca0..ed25ebe83 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -68,7 +68,9 @@ instance Compile Py.Call instance Compile Py.ClassDefinition instance Compile Py.ComparisonOperator -instance Compile Py.CompoundStatement where compile = compileSum +instance Compile Py.CompoundStatement where + compile = compileSum + compileCC = compileCCSum instance Compile Py.ConcatenatedString instance Compile Py.ConditionalExpression @@ -128,6 +130,12 @@ instance Compile Py.IfStatement where clause (Left Py.ElifClause{ condition, consequence }) rest = if' <$> compile condition <*> compile consequence <*> rest + 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 <*> compileCC consequence cc <*> rest + instance Compile Py.ImportFromStatement instance Compile Py.ImportStatement diff --git a/semantic-python/test/fixtures/2-03-return-in-if-statement.py b/semantic-python/test/fixtures/2-03-return-in-if-statement.py new file mode 100644 index 000000000..8243a9f42 --- /dev/null +++ b/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 () + () From 73668094c76e2fc0440ea57ed593995c4f576bca Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 11 Sep 2019 12:50:53 -0400 Subject: [PATCH 06/12] Use DerivingVia to squash forgotten-compileCCSum bugs. --- semantic-python/src/Language/Python/Core.hs | 28 +++++++++++---------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index ed25ebe83..18ed5f125 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE DefaultSignatures, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, OverloadedStrings, ScopedTypeVariables, NamedFieldPuns, TypeOperators #-} +{-# LANGUAGE DefaultSignatures, DeriveAnyClass, DerivingStrategies, DerivingVia, DisambiguateRecordFields, + FlexibleContexts, FlexibleInstances, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, + StandaloneDeriving, TypeOperators, UndecidableInstances, DeriveGeneric #-} module Language.Python.Core ( compile ) where @@ -38,9 +40,13 @@ 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 - compileCC = compileCCSum +newtype CompileSum py = CompileSum py + +instance (Generic py, GCompileSum (Rep py)) => Compile (CompileSum py) where + compile (CompileSum a) = compileSum a + compileCC (CompileSum a) cc = compileCCSum a cc + +deriving via CompileSum (Either l r) instance (Compile l, Compile r) => Compile (Either l r) instance Compile Py.AssertStatement instance Compile Py.Attribute @@ -68,9 +74,7 @@ instance Compile Py.Call instance Compile Py.ClassDefinition instance Compile Py.ComparisonOperator -instance Compile Py.CompoundStatement where - compile = compileSum - compileCC = compileCCSum +deriving via CompileSum Py.CompoundStatement instance Compile Py.CompoundStatement instance Compile Py.ConcatenatedString instance Compile Py.ConditionalExpression @@ -82,7 +86,7 @@ instance Compile Py.DictionaryComprehension instance Compile Py.Ellipsis instance Compile Py.ExecStatement -instance Compile Py.Expression where compile = compileSum +deriving via CompileSum Py.Expression instance Compile Py.Expression instance Compile Py.ExpressionStatement where compile (Py.ExpressionStatement children) = do @@ -113,7 +117,7 @@ instance Compile Py.FunctionDefinition where Nothing -> pure [] Just p -> traverse param [p] -- FIXME: this is wrong in node-types.json, @p@ should already be a list param (Right (Right (Right (Left (Py.Identifier name))))) = pure (named' name) - param x = unimplemented x + param x = unimplemented x unimplemented x = fail $ "unimplemented: " <> show x instance Compile Py.FutureImportStatement @@ -161,7 +165,7 @@ instance Compile Py.ParenthesizedExpression instance Compile Py.PassStatement where compile (Py.PassStatement _) = pure Core.unit -instance Compile Py.PrimaryExpression where compile = compileSum +deriving via CompileSum Py.PrimaryExpression instance Compile Py.PrimaryExpression instance Compile Py.PrintStatement @@ -177,9 +181,7 @@ instance Compile Py.RaiseStatement instance Compile Py.Set instance Compile Py.SetComprehension -instance Compile Py.SimpleStatement where - compile = compileSum - compileCC = compileCCSum +deriving via CompileSum Py.SimpleStatement instance Compile Py.SimpleStatement instance Compile Py.String instance Compile Py.Subscript From 38722321ce8942172b1ae15e9c1de7280be45d61 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 11 Sep 2019 15:41:48 -0400 Subject: [PATCH 07/12] Wording changes. --- semantic-python/src/Language/Python/Core.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index 18ed5f125..a6e52f0f7 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -65,7 +65,8 @@ instance Compile Py.BinaryOperator instance Compile Py.Block where compile t = compileCC t (pure none) - -- BUG: working around https://github.com/tree-sitter/haskell-tree-sitter/issues/195 + -- The call to 'reverse' works around https://github.com/tree-sitter/haskell-tree-sitter/issues/195 + -- This will be obviated when we upgrade to tree-sitter-python 0.3 compileCC (Py.Block body) cc = foldr compileCC cc (reverse body) instance Compile Py.BooleanOperator From aabfafc2e3309571d1210163d414e07d78f6fa77 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 17 Sep 2019 11:11:59 -0400 Subject: [PATCH 08/12] Address Rob's suggestions. --- semantic-python/src/Language/Python/Core.hs | 16 +++------------- 1 file changed, 3 insertions(+), 13 deletions(-) diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index 3478610ce..93a0b73b6 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -48,8 +48,8 @@ defaultCompile t = fail $ "compilation unimplemented for " <> show t newtype CompileSum py = CompileSum py instance (Generic py, GCompileSum (Rep py)) => Compile (CompileSum py) where - compile (CompileSum a) = compileSum a - compileCC (CompileSum a) cc = compileCCSum a cc + 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) @@ -131,11 +131,7 @@ 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 - clause (Left Py.ElifClause{ condition, consequence }) rest = - if' <$> compile condition <*> compile consequence <*> rest + compile stmt = compileCC stmt none compileCC Py.IfStatement{ condition, consequence, alternative} cc = if' <$> compile condition <*> compileCC consequence cc <*> foldr clause cc alternative @@ -194,12 +190,6 @@ 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 - -compileCCSum :: (Generic py, GCompileSum (Rep py), Member Core sig, Foldable t, Carrier sig t, MonadFail m) => py -> m (t Name) -> m (t Name) -compileCCSum = gcompileCCSum . from - class GCompileSum f where gcompileSum :: (Foldable t, Member Core sig, Carrier sig t, MonadFail m) => f a -> m (t Name) From 8b017f90c3e8b3d4ce69b77a9b7628300a456447 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 17 Sep 2019 11:12:26 -0400 Subject: [PATCH 09/12] Forgot a `pure`. --- semantic-python/src/Language/Python/Core.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index 93a0b73b6..ae41d02d0 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -131,7 +131,7 @@ instance Compile (Py.Identifier Span) where compile Py.Identifier { bytes } = pure (pure bytes) instance Compile (Py.IfStatement Span) where - compile stmt = compileCC stmt none + compile stmt = compileCC stmt (pure none) compileCC Py.IfStatement{ condition, consequence, alternative} cc = if' <$> compile condition <*> compileCC consequence cc <*> foldr clause cc alternative From 5d5e50c733cfb49e9d37e20bc80fdc3afba8d503 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 17 Sep 2019 16:19:10 -0400 Subject: [PATCH 10/12] Merge cleanup. --- semantic-python/src/Language/Python/Core.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index ae41d02d0..506bfea1a 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -1,10 +1,6 @@ -<<<<<<< HEAD {-# LANGUAGE DefaultSignatures, DeriveAnyClass, DerivingStrategies, DerivingVia, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances, DeriveGeneric #-} -======= -{-# LANGUAGE DefaultSignatures, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, OverloadedStrings, OverloadedLists, ScopedTypeVariables, NamedFieldPuns, TypeOperators #-} ->>>>>>> bump-to-tree-sitter-0.2.1 module Language.Python.Core ( compile ) where From 7437a280140afda3629a01a2c36cccdf0f490ff7 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 17 Sep 2019 16:26:45 -0400 Subject: [PATCH 11/12] Fix kindedness errors. --- semantic-python/src/Language/Python/Core.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index 506bfea1a..aa0093dca 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DefaultSignatures, DeriveAnyClass, DerivingStrategies, DerivingVia, DisambiguateRecordFields, - FlexibleContexts, FlexibleInstances, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, + FlexibleContexts, FlexibleInstances, NamedFieldPuns, OverloadedStrings, OverloadedLists, ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances, DeriveGeneric #-} module Language.Python.Core ( compile @@ -63,12 +63,10 @@ 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 body) cc = foldr compileCC cc body + compileCC Py.Block{ Py.extraChildren = body} cc = foldr compileCC cc body instance Compile (Py.BooleanOperator Span) instance Compile (Py.BreakStatement Span) @@ -76,7 +74,7 @@ instance Compile (Py.Call Span) instance Compile (Py.ClassDefinition Span) instance Compile (Py.ComparisonOperator Span) -deriving via CompileSum (Py.CompoundStatement Span) instance Compile Py.CompoundStatement +deriving via CompileSum (Py.CompoundStatement Span) instance Compile (Py.CompoundStatement Span) instance Compile (Py.ConcatenatedString Span) instance Compile (Py.ConditionalExpression Span) @@ -88,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 From e89e8462efc443eb58d62326c516ce4d7c36ffd1 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 18 Sep 2019 10:48:41 -0400 Subject: [PATCH 12/12] Reinstitute and rework Compile for ReturnStatement. --- semantic-python/src/Language/Python/Core.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index aa0093dca..aa00b65db 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -161,7 +161,16 @@ instance Compile (Py.PassStatement Span) where 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)