From 197cbde814f90f82924b7cd6f6277eb73e83710d Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Sat, 18 Nov 2023 14:40:07 +0000 Subject: [PATCH] Lovely --- smol-core/smol-core.cabal | 4 +- smol-core/src/Smol/Core/Modules/Parser.hs | 16 ++---- .../src/Smol/Core/Modules/Types/Entity.hs | 2 +- smol-core/src/Smol/Core/Parser/Identifiers.hs | 2 +- smol-core/src/Smol/Core/Types/ParseDep.hs | 2 +- smol-core/test/Main.hs | 4 +- smol-core/test/Test/Helpers.hs | 2 +- .../test/Test/Interpreter/InterpreterSpec.hs | 53 +++++++++++++++++++ smol-core/test/Test/Modules/CheckSpec.hs | 2 +- .../test/Test/Modules/InterpreterSpec.hs | 2 +- smol-core/test/Test/Modules/ParserSpec.hs | 2 - .../test/Test/Modules/PrettyPrintSpec.hs | 2 +- smol-core/test/Test/Modules/RunTestsSpec.hs | 2 +- smol-core/test/Test/Modules/TypecheckSpec.hs | 2 +- smol-core/test/Test/ParserSpec.hs | 1 - smol-repl/src/Smol/Check.hs | 2 +- smol-repl/src/Smol/Repl.hs | 2 +- 17 files changed, 73 insertions(+), 29 deletions(-) create mode 100644 smol-core/test/Test/Interpreter/InterpreterSpec.hs diff --git a/smol-core/smol-core.cabal b/smol-core/smol-core.cabal index eb3695935..cbb3dc5c1 100644 --- a/smol-core/smol-core.cabal +++ b/smol-core/smol-core.cabal @@ -75,6 +75,7 @@ library Smol.Core.Modules.FromParts Smol.Core.Modules.Helpers Smol.Core.Modules.Interpret + Smol.Core.Modules.Parser Smol.Core.Modules.PrettyPrint Smol.Core.Modules.ResolveDeps Smol.Core.Modules.RunTests @@ -86,7 +87,6 @@ library Smol.Core.Modules.Types.Module Smol.Core.Modules.Types.ModuleError Smol.Core.Modules.Types.ModuleItem - Smol.Core.Modules.Types.ModuleName Smol.Core.Modules.Types.Test Smol.Core.Modules.Types.TestName Smol.Core.Modules.Types.TopLevelExpression @@ -95,7 +95,6 @@ library Smol.Core.Parser.DataType Smol.Core.Parser.Expr Smol.Core.Parser.Identifiers - Smol.Core.Parser.Module Smol.Core.Parser.Op Smol.Core.Parser.Pattern Smol.Core.Parser.Primitives @@ -148,6 +147,7 @@ library Smol.Core.Types.DataType Smol.Core.Types.Expr Smol.Core.Types.Identifier + Smol.Core.Types.ModuleName Smol.Core.Types.Op Smol.Core.Types.ParseDep Smol.Core.Types.Pattern diff --git a/smol-core/src/Smol/Core/Modules/Parser.hs b/smol-core/src/Smol/Core/Modules/Parser.hs index aa0cfbb14..9642c9419 100644 --- a/smol-core/src/Smol/Core/Modules/Parser.hs +++ b/smol-core/src/Smol/Core/Modules/Parser.hs @@ -1,36 +1,30 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} - module Smol.Core.Modules.Parser - ( - moduleParser, - - + ( moduleParser, parseModule, parseModuleAndFormatError, ) where - +import Data.Bifunctor (first) import qualified Data.List.NonEmpty as NE import Data.Text (Text) +import qualified Data.Text as T import Data.Void import Smol.Core.Modules.Types.ModuleItem import Smol.Core.Modules.Types.TestName import Smol.Core.Parser.DataType (dataTypeParser) import Smol.Core.Parser.Expr import Smol.Core.Parser.Identifiers +import Smol.Core.Parser.Primitives (textPrim) import Smol.Core.Parser.Shared import Smol.Core.Parser.Type import Smol.Core.Parser.Typeclass import Smol.Core.Typecheck.Typeclass.Types import Smol.Core.Types import Text.Megaparsec hiding (parseTest) -import Smol.Core.Parser.Primitives (textPrim) -import Data.Bifunctor (first) -import qualified Data.Text as T import Text.Megaparsec.Char type Parser = Parsec Void Text @@ -48,8 +42,6 @@ parseModuleAndFormatError = parseAndFormat (space *> moduleParser <* eof) ------- - - -- currently fails at the first hurdle -- since we can parse each thing separately, maybe -- we should be making each throw errors for later, but returning `mempty` so diff --git a/smol-core/src/Smol/Core/Modules/Types/Entity.hs b/smol-core/src/Smol/Core/Modules/Types/Entity.hs index d8d1b98aa..347584171 100644 --- a/smol-core/src/Smol/Core/Modules/Types/Entity.hs +++ b/smol-core/src/Smol/Core/Modules/Types/Entity.hs @@ -9,10 +9,10 @@ module Smol.Core.Modules.Types.Entity where -- terrible, pls improve import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey) import GHC.Generics (Generic) -import Smol.Core.Types.ModuleName import Smol.Core.Printer import Smol.Core.Types.Constructor import Smol.Core.Types.Identifier +import Smol.Core.Types.ModuleName import Smol.Core.Types.TypeName data Entity diff --git a/smol-core/src/Smol/Core/Parser/Identifiers.hs b/smol-core/src/Smol/Core/Parser/Identifiers.hs index 6c61f8599..472540532 100644 --- a/smol-core/src/Smol/Core/Parser/Identifiers.hs +++ b/smol-core/src/Smol/Core/Parser/Identifiers.hs @@ -19,10 +19,10 @@ import Data.Set (Set) import qualified Data.Set as S import Data.Text (Text) import Data.Void -import Smol.Core.Types.ModuleName import Smol.Core.Parser.Shared import Smol.Core.Typecheck.Typeclass.Types import Smol.Core.Types +import Smol.Core.Types.ModuleName import Text.Megaparsec type Parser = Parsec Void Text diff --git a/smol-core/src/Smol/Core/Types/ParseDep.hs b/smol-core/src/Smol/Core/Types/ParseDep.hs index 8505703a7..e5c2d4b0e 100644 --- a/smol-core/src/Smol/Core/Types/ParseDep.hs +++ b/smol-core/src/Smol/Core/Types/ParseDep.hs @@ -13,8 +13,8 @@ where import Data.Aeson (FromJSON, ToJSON) import Data.String import GHC.Generics (Generic) -import Smol.Core.Types.ModuleName import Smol.Core.Printer +import Smol.Core.Types.ModuleName --------------------------- diff --git a/smol-core/test/Main.hs b/smol-core/test/Main.hs index 6b898c0b3..455a330e6 100644 --- a/smol-core/test/Main.hs +++ b/smol-core/test/Main.hs @@ -1,14 +1,15 @@ module Main (main) where import Test.Hspec +import qualified Test.Interpreter.InterpreterSpec import qualified Test.Modules.CheckSpec import qualified Test.Modules.FromPartsSpec import qualified Test.Modules.InterpreterSpec +import qualified Test.Modules.ParserSpec import qualified Test.Modules.PrettyPrintSpec import qualified Test.Modules.ResolveDepsSpec import qualified Test.Modules.RunTestsSpec import qualified Test.Modules.TypecheckSpec -import qualified Test.Modules.ParserSpec import qualified Test.ParserSpec import qualified Test.TransformSpec import qualified Test.Typecheck.ExhaustivenessSpec @@ -38,3 +39,4 @@ main = hspec $ parallel $ do Test.Modules.TypecheckSpec.spec Test.Modules.ParserSpec.spec Test.TransformSpec.spec + Test.Interpreter.InterpreterSpec.spec diff --git a/smol-core/test/Test/Helpers.hs b/smol-core/test/Test/Helpers.hs index 9d9818a88..aa7753b41 100644 --- a/smol-core/test/Test/Helpers.hs +++ b/smol-core/test/Test/Helpers.hs @@ -58,6 +58,7 @@ import Data.Text (Text) import qualified Data.Text as T import Smol.Core import Smol.Core.Modules.FromParts +import Smol.Core.Modules.Parser import Smol.Core.Modules.ResolveDeps import Smol.Core.Modules.Typecheck import Smol.Core.Modules.Types.Module @@ -65,7 +66,6 @@ import Smol.Core.Modules.Types.ModuleError import Smol.Core.Modules.Types.ModuleItem import Smol.Core.Typecheck.FromParsedExpr import Test.BuiltInTypes (builtInTypes) -import Smol.Core.Modules.Parser typedModule :: (MonadError (ModuleError Annotation) m) => diff --git a/smol-core/test/Test/Interpreter/InterpreterSpec.hs b/smol-core/test/Test/Interpreter/InterpreterSpec.hs new file mode 100644 index 000000000..39b11ccd6 --- /dev/null +++ b/smol-core/test/Test/Interpreter/InterpreterSpec.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Interpreter.InterpreterSpec (spec) where + +import Data.Foldable (traverse_) +import Data.Text (Text) +import Smol.Core +import Smol.Core.Interpreter.Types.Stack +import Smol.Core.Typecheck.FromParsedExpr +import Test.Helpers +import Test.Hspec + +-- | interpret without typechecking etc +doBasicInterpret :: Text -> Expr ResolvedDep () +doBasicInterpret = + fmap edAnnotation + . discardLeft + . interpret mempty + . addEmptyStackFrames + . fromParsedExpr + . unsafeParseExpr + +discardLeft :: (Show e) => Either e a -> a +discardLeft (Left e) = error (show e) +discardLeft (Right a) = a + +spec :: Spec +spec = do + describe "InterpreterSpec" $ do + describe "interpret" $ do + let cases = + [ ("1 + 1", "2"), + ("-11 + 1", "-10"), + ("(\\a -> a + 1) 41", "42"), + ("(\\a -> if a then 1 else 2) False", "2"), + ("(\\a -> if a then 1 else 2) True", "1"), + ("let a = 41 in a + 1", "42"), + ("Just (1 + 1)", "Just 2"), + ("case (Just 1) { Just a -> a + 41, Nothing -> 0 }", "42"), + ("case Nothing { Just a -> a + 41, Nothing -> 0 }", "0"), + ("let stuff = { x: 1, y : 2 }; stuff.x + stuff.y", "3"), + ("let id = \\a -> a; (id 1, id 2, id 3)", "(1,2,3)"), + ("[1,2 + 3]", "[1,5]"), + ("case [1,2,3] { [_, ...rest] -> rest, _ -> [42] }", "[2,3]"), + ("let f = \\a -> if a == 10 then a else a + f (a + 1); f 0", "55") + ] + traverse_ + ( \(input, expect) -> + it (show input <> " = " <> show expect) $ do + doBasicInterpret input + `shouldBe` fromParsedExpr (unsafeParseExpr expect) + ) + cases diff --git a/smol-core/test/Test/Modules/CheckSpec.hs b/smol-core/test/Test/Modules/CheckSpec.hs index 20330c33c..e5c4125d1 100644 --- a/smol-core/test/Test/Modules/CheckSpec.hs +++ b/smol-core/test/Test/Modules/CheckSpec.hs @@ -5,7 +5,6 @@ -- | test evaluating and running tests for a module module Test.Modules.CheckSpec (spec) where -import Smol.Core.Modules.Parser import Data.Bifunctor (second) import Data.FileEmbed @@ -16,6 +15,7 @@ import Data.Text (Text) import qualified Data.Text.Encoding as T import Smol.Core import Smol.Core.Modules.Check +import Smol.Core.Modules.Parser import Smol.Core.Modules.RunTests import Smol.Core.Modules.Types.ModuleError import Test.Hspec diff --git a/smol-core/test/Test/Modules/InterpreterSpec.hs b/smol-core/test/Test/Modules/InterpreterSpec.hs index 9b5b5d6b0..10e7f99d2 100644 --- a/smol-core/test/Test/Modules/InterpreterSpec.hs +++ b/smol-core/test/Test/Modules/InterpreterSpec.hs @@ -2,7 +2,6 @@ module Test.Modules.InterpreterSpec (spec) where -import Smol.Core.Modules.Parser import Control.Monad (void) import Data.Foldable (traverse_) import Data.Text (Text) @@ -10,6 +9,7 @@ import qualified Error.Diagnose as Diag import Smol.Core import Smol.Core.Modules.Check import Smol.Core.Modules.Interpret +import Smol.Core.Modules.Parser import Smol.Core.Modules.Types.DefIdentifier import Smol.Core.Modules.Types.ModuleError import Smol.Core.Typecheck.FromParsedExpr diff --git a/smol-core/test/Test/Modules/ParserSpec.hs b/smol-core/test/Test/Modules/ParserSpec.hs index b14caffe8..77c7fbb00 100644 --- a/smol-core/test/Test/Modules/ParserSpec.hs +++ b/smol-core/test/Test/Modules/ParserSpec.hs @@ -55,5 +55,3 @@ spec = do result `shouldSatisfy` isRight ) testInputs - - diff --git a/smol-core/test/Test/Modules/PrettyPrintSpec.hs b/smol-core/test/Test/Modules/PrettyPrintSpec.hs index 441bfa731..a604595df 100644 --- a/smol-core/test/Test/Modules/PrettyPrintSpec.hs +++ b/smol-core/test/Test/Modules/PrettyPrintSpec.hs @@ -6,13 +6,13 @@ -- | test evaluating and running tests for a module module Test.Modules.PrettyPrintSpec (spec) where -import qualified Smol.Core.Modules.Parser as Parse import Data.Bifunctor (second) import Data.FileEmbed import Data.Foldable (traverse_) import Data.Functor import Data.Text (Text) import qualified Data.Text.Encoding as T +import qualified Smol.Core.Modules.Parser as Parse import Smol.Core.Modules.PrettyPrint (printModuleParts) import Smol.Core.Modules.Types.ModuleItem import Smol.Core.Printer diff --git a/smol-core/test/Test/Modules/RunTestsSpec.hs b/smol-core/test/Test/Modules/RunTestsSpec.hs index 614916ebe..8d8d29855 100644 --- a/smol-core/test/Test/Modules/RunTestsSpec.hs +++ b/smol-core/test/Test/Modules/RunTestsSpec.hs @@ -1,11 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module Test.Modules.RunTestsSpec (spec) where -import Smol.Core.Modules.Parser import qualified Data.Text as T import Smol.Core import Smol.Core.Modules.Check +import Smol.Core.Modules.Parser import Smol.Core.Modules.RunTests import Smol.Core.Modules.Types import Smol.Core.Modules.Types.ModuleError diff --git a/smol-core/test/Test/Modules/TypecheckSpec.hs b/smol-core/test/Test/Modules/TypecheckSpec.hs index ae925db47..84ad5df57 100644 --- a/smol-core/test/Test/Modules/TypecheckSpec.hs +++ b/smol-core/test/Test/Modules/TypecheckSpec.hs @@ -4,7 +4,6 @@ {-# LANGUAGE TemplateHaskell #-} module Test.Modules.TypecheckSpec (spec) where -import Smol.Core.Modules.Parser import Data.Bifunctor (second) import Data.Either (isRight) @@ -14,6 +13,7 @@ import Data.Text (Text) import qualified Data.Text.Encoding as T import Smol.Core import Smol.Core.Modules.Check +import Smol.Core.Modules.Parser import Smol.Core.Modules.Types hiding (Entity (..)) import Smol.Core.Modules.Types.ModuleError import Test.Helpers diff --git a/smol-core/test/Test/ParserSpec.hs b/smol-core/test/Test/ParserSpec.hs index 1234771b3..2890413bb 100644 --- a/smol-core/test/Test/ParserSpec.hs +++ b/smol-core/test/Test/ParserSpec.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module Test.ParserSpec (spec) where diff --git a/smol-repl/src/Smol/Check.hs b/smol-repl/src/Smol/Check.hs index 9743407d0..ee3605013 100644 --- a/smol-repl/src/Smol/Check.hs +++ b/smol-repl/src/Smol/Check.hs @@ -9,11 +9,11 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import Smol.Core.Modules.Check +import Smol.Core.Modules.Parser (parseModule) import Smol.Core.Modules.PrettyPrint (printModuleParts) import Smol.Core.Modules.RunTests import Smol.Core.Modules.Types.ModuleError import Smol.Core.Modules.Types.ModuleItem -import Smol.Core.Parser (parseModule) import Smol.Core.Printer import Smol.Repl.Helpers.Diagnostics import Smol.Repl.Helpers.ShowTestResults diff --git a/smol-repl/src/Smol/Repl.hs b/smol-repl/src/Smol/Repl.hs index 58066ad6b..9daeffbfe 100644 --- a/smol-repl/src/Smol/Repl.hs +++ b/smol-repl/src/Smol/Repl.hs @@ -14,9 +14,9 @@ import qualified Smol.Backend.Compile.RunLLVM as Run import Smol.Backend.IR.FromExpr.Expr import Smol.Backend.IR.ToLLVM.ToLLVM import Smol.Core.Modules.Check +import Smol.Core.Modules.Parser (parseModule) import Smol.Core.Modules.RunTests import Smol.Core.Modules.Types.ModuleError -import Smol.Core.Parser (parseModule) import Smol.Repl.Helpers.Diagnostics import Smol.Repl.Helpers.ShowTestResults import System.Console.Haskeline