diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index 2fb87f130..27458c359 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ConstraintKinds, DataKinds, DefaultSignatures, DisambiguateRecordFields, FlexibleContexts, GeneralizedNewtypeDeriving, KindSignatures, LambdaCase, NamedFieldPuns, OverloadedLists, - PatternSynonyms, StandaloneDeriving, TypeApplications, TypeOperators, ViewPatterns #-} + OverloadedStrings, PatternSynonyms, StandaloneDeriving, TypeApplications, TypeOperators, ViewPatterns #-} module Language.Python.Core ( toplevelCompile @@ -18,7 +18,7 @@ import Core.Name as Name import Data.Coerce import Data.Foldable import Data.Function -import Data.List.NonEmpty (NonEmpty (..)) +import Data.List.NonEmpty (NonEmpty (..)) import GHC.Records import Source.Span (Span) import Syntax.Stack (Stack (..)) @@ -194,7 +194,22 @@ instance Compile Py.Call where locate it (func $$* args) & cc compile it _ _ = fail ("can't compile Call node with generator expression: " <> show it) -instance Compile Py.ClassDefinition +instance Compile Py.ClassDefinition where + compile it@Py.ClassDefinition { body = pybody, name = Py.Identifier _ann (Name -> n) } cc next = do + let buildTypeCall _ = do + bindings <- asks @Bindings (toList . unBindings) + let buildName n = (n, pure n) + contents = record . fmap buildName $ bindings + typefn = pure "__semantic_prelude" ... "type" + object = pure "__semantic_prelude" ... "object" + + pure (typefn $$ Core.string (coerce n) $$ object $$ contents) + + body <- compile pybody buildTypeCall next + let assignClass = Name.named' n :<- body + let continuing = fmap (locate it . (assignClass >>>=)) + continuing (local (def n) (cc next)) + instance Compile Py.ComparisonOperator deriving instance Compile Py.CompoundStatement diff --git a/semantic-python/src/Prelude.score b/semantic-python/src/Prelude.score new file mode 100644 index 000000000..d8b4b94f8 --- /dev/null +++ b/semantic-python/src/Prelude.score @@ -0,0 +1,8 @@ +{ + type <- \name -> \bases -> \dict -> + #record { __name: name, __bases: bases, __dict: dict }; + + object <- type "object" #unit #record{}; + + #record { type: type, object: object } +} diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs index 75fb06bb2..ca57e3d62 100644 --- a/semantic-python/test/Test.hs +++ b/semantic-python/test/Test.hs @@ -12,6 +12,7 @@ import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Trans.Resource (ResourceT, runResourceT) import Core.Core +import qualified Core.Parser import Core.Pretty import qualified Core.Eval as Eval import Core.Name @@ -38,6 +39,7 @@ import qualified System.Path as Path import qualified System.Path.Directory as Path import System.Path (()) import Text.Show.Pretty (ppShow) +import qualified Text.Trifecta as Trifecta import qualified TreeSitter.Python as TSP import qualified TreeSitter.Unmarshal as TS @@ -50,12 +52,20 @@ import Instances () assertJQExpressionSucceeds :: Show a => Directive.Directive -> a -> Term (Ann Span :+: Core) Name -> HUnit.Assertion assertJQExpressionSucceeds directive tree core = do - bod <- case scopeGraph Eval.eval [File (Path.absRel "") (Span (Pos 1 1) (Pos 1 1)) core] of + preludesrc <- ByteString.readFile "semantic-python/src/Prelude.score" + let ePrelude = Trifecta.parseByteString (Core.Parser.core <* Trifecta.eof) mempty preludesrc + prelude <- case Trifecta.foldResult (Left . show) Right ePrelude of + Right r -> pure r + Left s -> HUnit.assertFailure ("Couldn't parse prelude: " <> s) + + let allTogether = (named' "__semantic_prelude" :<- prelude) >>>= core + + bod <- case scopeGraph Eval.eval [File (Path.absRel "") (Span (Pos 1 1) (Pos 1 1)) allTogether] of (heap, [File _ _ (Right result)]) -> pure $ Aeson.object [ "scope" Aeson..= heap , "heap" Aeson..= result ] - _other -> HUnit.assertFailure "Couldn't run scope dumping mechanism; this shouldn't happen" + other -> HUnit.assertFailure ("Couldn't run scope dumping mechanism: " <> showCore (stripAnnotations allTogether) <> "\n" <> show other) let ignore = ByteStream.effects . hoist ByteStream.effects sgJSON = ByteStream.fromLazy $ Aeson.encode bod diff --git a/semantic-python/test/fixtures/1-01-empty-module.py b/semantic-python/test/fixtures/1-01-empty-module.py index 1ea1a6ad8..95226452b 100644 --- a/semantic-python/test/fixtures/1-01-empty-module.py +++ b/semantic-python/test/fixtures/1-01-empty-module.py @@ -1,2 +1 @@ -# CHECK-JQ: .scope == {} -# CHECK-JQ: .heap == {} +# CHECK-JQ: .scope | has("__semantic_prelude") # prelude should be present diff --git a/semantic-python/test/fixtures/1-02-pass-statement.py b/semantic-python/test/fixtures/1-02-pass-statement.py index e3f0f81a8..d9f8dda1b 100644 --- a/semantic-python/test/fixtures/1-02-pass-statement.py +++ b/semantic-python/test/fixtures/1-02-pass-statement.py @@ -1,2 +1,2 @@ -# CHECK-JQ: .scope == {} +# CHECK-JQ: .scope | has("__semantic_prelude") pass diff --git a/semantic-python/test/fixtures/1-03-empty-tuple.py b/semantic-python/test/fixtures/1-03-empty-tuple.py index 5e0310d14..404f14e6e 100644 --- a/semantic-python/test/fixtures/1-03-empty-tuple.py +++ b/semantic-python/test/fixtures/1-03-empty-tuple.py @@ -1,3 +1,2 @@ -# CHECK-JQ: .scope == {} # CHECK-TREE: #record{} () diff --git a/semantic-python/test/fixtures/3-01-empty-class-definition.py b/semantic-python/test/fixtures/3-01-empty-class-definition.py new file mode 100644 index 000000000..5b6a95c4a --- /dev/null +++ b/semantic-python/test/fixtures/3-01-empty-class-definition.py @@ -0,0 +1,3 @@ +# CHECK-TREE: { Foo <- __semantic_prelude.type "Foo" __semantic_prelude.object #record {}; #record { Foo: Foo }} +class Foo(): + pass diff --git a/semantic-python/test/fixtures/3-02-defining-instance-method.py b/semantic-python/test/fixtures/3-02-defining-instance-method.py new file mode 100644 index 000000000..53772709e --- /dev/null +++ b/semantic-python/test/fixtures/3-02-defining-instance-method.py @@ -0,0 +1,5 @@ +# CHECK-TREE: { Foo <- { identity <- \self -> \x -> x; __semantic_prelude.type "Foo" __semantic_prelude.object #record { identity: identity } }; #record { Foo: Foo } } + +class Foo(): + def identity(self, x): + return x