diff --git a/docs/core-grammar.md b/docs/core-grammar.md new file mode 100644 index 0000000000..a353af7bf2 --- /dev/null +++ b/docs/core-grammar.md @@ -0,0 +1,30 @@ +# Semantic Core grammar + +This is an EBNF grammar for the (experimental) core IR language. + +``` +expr ::= expr '.' expr + | expr ' '+ expr + | '{' expr (';' expr)* ';'? '}' + | 'if' expr 'then' expr 'else' expr + | ('lexical' | 'import' | 'load') expr + | lit + | 'let'? lvalue '=' expr + | '(' expr ')' + +lvalue ::= ident + | parens expr + +lit ::= '#true' + | '#false' + | 'unit' + | 'frame' + | lambda + | ident + +lambda ::= ('λ' | '\') ident ('->' | '→') expr + +ident ::= [A-z_] ([A-z0-9_])* + | '#{' [^{}]+ '}' + | '"' [^"]+ '"' +``` diff --git a/semantic-core/semantic-core.cabal b/semantic-core/semantic-core.cabal index 5427b62511..b608ad41f6 100644 --- a/semantic-core/semantic-core.cabal +++ b/semantic-core/semantic-core.cabal @@ -26,22 +26,29 @@ library , Analysis.Typecheck , Control.Effect.Readline , Data.Core + , Data.Core.Parser + , Data.Core.Pretty , Data.File , Data.Loc , Data.Name , Data.Stack -- other-modules: -- other-extensions: - build-depends: algebraic-graphs ^>= 0.3 - , base >= 4.11 && < 5 - , containers ^>= 0.6 - , directory ^>= 1.3 - , filepath ^>= 1.4 - , fused-effects ^>= 0.4 - , haskeline ^>= 0.7.5 - , prettyprinter ^>= 1.2.1 - , semigroupoids ^>= 5.3 - , transformers ^>= 0.5.6 + build-depends: algebraic-graphs ^>= 0.3 + , base >= 4.11 && < 5 + , containers ^>= 0.6 + , directory ^>= 1.3 + , filepath ^>= 1.4 + , fused-effects ^>= 0.4 + , haskeline ^>= 0.7.5 + , parsers ^>= 0.12.10 + , prettyprinter ^>= 1.2.1 + , prettyprinter-ansi-terminal ^>= 1.1.1 + , recursion-schemes ^>= 5.1 + , semigroupoids ^>= 5.3 + , transformers ^>= 0.5.6 + , trifecta ^>= 2 + , unordered-containers ^>= 0.2.10 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Weverything -Wno-missing-local-signatures -Wno-missing-import-lists -Wno-implicit-prelude -Wno-safe -Wno-unsafe -Wno-name-shadowing -Wno-monomorphism-restriction -Wno-missed-specialisations -Wno-all-missed-specialisations @@ -57,3 +64,17 @@ test-suite doctest , semantic-core hs-source-dirs: test default-language: Haskell2010 + +test-suite spec + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: Generators + build-depends: base + , semantic-core + , hedgehog >= 0.6 && <1 + , tasty >= 1.2 && <2 + , tasty-hedgehog >= 0.2 && <1 + , tasty-hunit >= 0.10 && <1 + , trifecta + hs-source-dirs: test + default-language: Haskell2010 diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs index 7940112967..4e296e9a32 100644 --- a/semantic-core/src/Analysis/Eval.hs +++ b/semantic-core/src/Analysis/Eval.hs @@ -119,7 +119,7 @@ prog6 = ] ] , File (Loc "main" (locSpan (fromJust here))) $ block - [ Load (String "dep") + [ Load (Var (Path "dep")) , Let (User "thing") := Var (Path "dep") :. Var (User "var") ] ] diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs index 952f11ed90..6cb92dcd9f 100644 --- a/semantic-core/src/Data/Core.hs +++ b/semantic-core/src/Data/Core.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE DeriveTraversable, FlexibleContexts, LambdaCase, OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE DeriveTraversable, FlexibleContexts, LambdaCase, OverloadedStrings, RecordWildCards, TemplateHaskell, TypeFamilies #-} module Data.Core ( Core(..) +, CoreF(..) , Edge(..) -, showCore , lams , ($$*) , unapply @@ -10,18 +10,21 @@ module Data.Core , block , ann , annWith +, stripAnnotations ) where import Control.Applicative (Alternative (..)) +import Data.Functor.Foldable hiding (ListF(..)) +import Data.Functor.Foldable.TH import Data.Foldable (foldl') import Data.Loc import Data.Name import Data.Stack -import Data.Text.Prettyprint.Doc (Pretty (..), (<+>), vsep) -import qualified Data.Text.Prettyprint.Doc as Pretty -import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty import GHC.Stack +data Edge = Lexical | Import + deriving (Eq, Ord, Show) + data Core = Var Name | Let Name @@ -50,52 +53,16 @@ infixr 1 :>> infix 3 := infixl 4 :. -data Edge = Lexical | Import - deriving (Eq, Ord, Show) +makeBaseFunctor ''Core -instance Pretty Edge where - pretty = pretty . show +infixl 2 :$$ +infixr 1 :>>$ +infix 3 :=$ +infixl 4 :.$ instance Semigroup Core where (<>) = (:>>) -softsemi :: Pretty.Doc a -softsemi = Pretty.flatAlt mempty ";" - -showCore :: Core -> String -showCore = Pretty.renderString . Pretty.layoutPretty Pretty.defaultLayoutOptions . pretty - -instance Pretty Core where - pretty = \case - Var a -> pretty a - Let a -> "let" <+> pretty a - a :>> b -> vsep [pretty a <> softsemi, pretty b] - - Lam x f -> vsep [ Pretty.nest 2 $ vsep [ "λ" <> pretty x <+> "-> {" - , pretty f - ] - , "}" - ] - - f :$ x -> pretty f <> "." <> pretty x - Unit -> Pretty.parens mempty - Bool b -> pretty b - If c x y -> Pretty.sep [ "if" <+> pretty c - , "then" <+> pretty x - , "else" <+> pretty y - ] - - String s -> pretty (show s) - - Frame -> Pretty.braces mempty - - Load p -> "load" <+> pretty p - Edge e n -> pretty e <+> pretty n - a :. b -> "push" <+> Pretty.parens (pretty a) <+> Pretty.brackets (pretty b) - var := x -> pretty var <+> "=" <+> pretty x - Ann (Loc p s) c -> pretty c <> Pretty.brackets (pretty p <> ":" <> pretty s) - - lams :: Foldable t => t Name -> Core -> Core lams names body = foldr Lam body names @@ -124,3 +91,8 @@ ann = annWith callStack annWith :: CallStack -> Core -> Core annWith callStack c = maybe c (flip Ann c) (stackLoc callStack) + +stripAnnotations :: Core -> Core +stripAnnotations = cata go where + go (AnnF _ item) = item + go item = embed item diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs new file mode 100644 index 0000000000..4e8df75706 --- /dev/null +++ b/semantic-core/src/Data/Core/Parser.hs @@ -0,0 +1,115 @@ +module Data.Core.Parser + ( module Text.Trifecta + , core + , lit + , expr + , lvalue + ) where + +-- Consult @doc/grammar.md@ for an EBNF grammar. + +import Control.Applicative +import qualified Data.Char as Char +import Data.Core +import Data.Name +import Data.Semigroup +import Data.String +import qualified Text.Parser.Token as Token +import qualified Text.Parser.Token.Highlight as Highlight +import Text.Trifecta hiding (ident) + +-- * Identifier styles and derived parsers + +validIdentifierStart :: Char -> Bool +validIdentifierStart c = not (Char.isDigit c) && isSimpleCharacter c + +coreIdents :: TokenParsing m => IdentifierStyle m +coreIdents = Token.IdentifierStyle + { _styleName = "core" + , _styleStart = satisfy validIdentifierStart + , _styleLetter = satisfy isSimpleCharacter + , _styleReserved = reservedNames + , _styleHighlight = Highlight.Identifier + , _styleReservedHighlight = Highlight.ReservedIdentifier + } + +reserved :: (TokenParsing m, Monad m) => String -> m () +reserved = Token.reserve coreIdents + +identifier :: (TokenParsing m, Monad m, IsString s) => m s +identifier = choice [quote, plain] "identifier" where + plain = Token.ident coreIdents + quote = between (string "#{") (symbol "}") (fromString <$> some (noneOf "{}")) + +-- * Parsers (corresponding to EBNF) + +core :: (TokenParsing m, Monad m) => m Core +core = expr + +expr :: (TokenParsing m, Monad m) => m Core +expr = atom `chainl1` go where + go = choice [ (:.) <$ dot + , (:$) <$ notFollowedBy dot + ] + +atom :: (TokenParsing m, Monad m) => m Core +atom = choice + [ comp + , ifthenelse + , edge + , lit + , ident + , assign + , parens expr + ] + +comp :: (TokenParsing m, Monad m) => m Core +comp = braces (sconcat <$> sepEndByNonEmpty expr semi) "compound statement" + +ifthenelse :: (TokenParsing m, Monad m) => m Core +ifthenelse = If + <$ reserved "if" <*> core + <* reserved "then" <*> core + <* reserved "else" <*> core + "if-then-else statement" + +assign :: (TokenParsing m, Monad m) => m Core +assign = (:=) <$> try (lvalue <* symbolic '=') <*> core "assignment" + +edge :: (TokenParsing m, Monad m) => m Core +edge = kw <*> expr where kw = choice [ Edge Lexical <$ reserved "lexical" + , Edge Import <$ reserved "import" + , Load <$ reserved "load" + ] + +lvalue :: (TokenParsing m, Monad m) => m Core +lvalue = choice + [ Let <$ reserved "let" <*> name + , ident + , parens expr + ] + +-- * Literals + +name :: (TokenParsing m, Monad m) => m Name +name = choice [regular, strpath] "name" where + regular = User <$> identifier + strpath = Path <$> between (symbolic '"') (symbolic '"') (some $ noneOf "\"") + +lit :: (TokenParsing m, Monad m) => m Core +lit = let x `given` n = x <$ reserved n in choice + [ Bool True `given` "#true" + , Bool False `given` "#false" + , Unit `given` "#unit" + , Frame `given` "#frame" + , lambda + ] "literal" + +lambda :: (TokenParsing m, Monad m) => m Core +lambda = Lam <$ lambduh <*> name <* arrow <*> core "lambda" where + lambduh = symbolic 'λ' <|> symbolic '\\' + arrow = symbol "→" <|> symbol "->" + +ident :: (Monad m, TokenParsing m) => m Core +ident = Var <$> name "identifier" + diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs new file mode 100644 index 0000000000..0229769079 --- /dev/null +++ b/semantic-core/src/Data/Core/Pretty.hs @@ -0,0 +1,130 @@ +{-# LANGUAGE FlexibleContexts, LambdaCase, OverloadedStrings, TypeApplications #-} + +module Data.Core.Pretty + ( showCore + , printCore + , showFile + , printFile + , prettyCore + ) where + +import Control.Effect +import Control.Effect.Reader +import Data.Core +import Data.File +import Data.Functor.Foldable +import Data.Name +import Data.Text.Prettyprint.Doc (Pretty (..), annotate, softline, (<+>)) +import qualified Data.Text.Prettyprint.Doc as Pretty +import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty +import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty + +showCore :: Core -> String +showCore = Pretty.renderString . Pretty.layoutSmart Pretty.defaultLayoutOptions . Pretty.unAnnotate . prettyCore Ascii + +printCore :: Core -> IO () +printCore p = Pretty.putDoc (prettyCore Unicode p) *> putStrLn "" + +showFile :: File Core -> String +showFile = showCore . fileBody + +printFile :: File Core -> IO () +printFile = printCore . fileBody + +type AnsiDoc = Pretty.Doc Pretty.AnsiStyle + +keyword, symbol, strlit, primitive :: AnsiDoc -> AnsiDoc +keyword = annotate (Pretty.colorDull Pretty.Cyan) +symbol = annotate (Pretty.color Pretty.Yellow) +strlit = annotate (Pretty.colorDull Pretty.Green) +primitive = keyword . mappend "#" + +type Prec = Int + +data Style = Unicode | Ascii + +lambda, arrow :: (Member (Reader Style) sig, Carrier sig m) => m AnsiDoc +lambda = ask @Style >>= \case + Unicode -> pure $ symbol "λ" + Ascii -> pure $ symbol "\\" +arrow = ask @Style >>= \case + Unicode -> pure $ symbol "→" + Ascii -> pure $ symbol "->" + +name :: Name -> AnsiDoc +name = \case + Gen p -> pretty p + Path p -> strlit (Pretty.viaShow p) + User n -> encloseIf (needsQuotation n) (symbol "#{") (symbol "}") (pretty n) + +with :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m a -> m a +with n = local (const n) + +inParens :: (Member (Reader Prec) sig, Carrier sig m) => Prec -> m AnsiDoc -> m AnsiDoc +inParens amount go = do + prec <- ask + body <- with amount go + pure (encloseIf (amount >= prec) (symbol "(") (symbol ")") body) + +encloseIf :: Monoid m => Bool -> m -> m -> m -> m +encloseIf True l r x = l <> x <> r +encloseIf False _ _ x = x + +prettify :: (Member (Reader Prec) sig, Member (Reader Style) sig, Carrier sig m) + => CoreF (m AnsiDoc) + -> m AnsiDoc +prettify = \case + VarF a -> pure $ name a + LetF a -> pure $ keyword "let" <+> name a + a :>>$ b -> do + prec <- ask @Prec + fore <- with 12 a + aft <- with 12 b + + let open = symbol ("{" <> softline) + close = symbol (softline <> "}") + separator = ";" <> Pretty.line + body = fore <> separator <> aft + + pure . Pretty.align $ encloseIf (12 > prec) open close (Pretty.align body) + + LamF x f -> inParens 11 $ do + body <- f + lam <- lambda + arr <- arrow + pure (lam <> name x <+> arr <+> body) + + FrameF -> pure $ primitive "frame" + UnitF -> pure $ primitive "unit" + BoolF b -> pure $ primitive (if b then "true" else "false") + StringF s -> pure . strlit $ Pretty.viaShow s + + f :$$ x -> inParens 11 $ (<+>) <$> f <*> x + + IfF con tru fal -> do + con' <- "if" `appending` con + tru' <- "then" `appending` tru + fal' <- "else" `appending` fal + pure $ Pretty.sep [con', tru', fal'] + + LoadF p -> "load" `appending` p + EdgeF Lexical n -> "lexical" `appending` n + EdgeF Import n -> "import" `appending` n + item :.$ body -> inParens 5 $ do + f <- item + g <- body + pure (f <> symbol "." <> g) + + lhs :=$ rhs -> inParens 4 $ do + f <- lhs + g <- rhs + pure (f <+> symbol "=" <+> g) + + -- Annotations are not pretty-printed, as it lowers the signal/noise ratio too profoundly. + AnnF _ c -> c + +appending :: Functor f => AnsiDoc -> f AnsiDoc -> f AnsiDoc +appending k item = (keyword k <+>) <$> item + +prettyCore :: Style -> Core -> AnsiDoc +prettyCore s = run . runReader @Prec 0 . runReader s . cata prettify diff --git a/semantic-core/src/Data/Name.hs b/semantic-core/src/Data/Name.hs index 9ae8cf17d1..ccffcb30c9 100644 --- a/semantic-core/src/Data/Name.hs +++ b/semantic-core/src/Data/Name.hs @@ -1,8 +1,11 @@ -{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, OverloadedStrings, StandaloneDeriving, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, OverloadedLists, OverloadedStrings,StandaloneDeriving, TypeOperators, UndecidableInstances #-} module Data.Name ( User , Namespaced , Name(..) +, reservedNames +, isSimpleCharacter +, needsQuotation , Gensym(..) , (//) , gensym @@ -20,6 +23,9 @@ import Control.Effect.State import Control.Effect.Sum import Control.Monad.Fail import Control.Monad.IO.Class +import qualified Data.Char as Char +import Data.HashSet (HashSet) +import qualified Data.HashSet as HashSet import Data.Text.Prettyprint.Doc (Pretty (..)) import qualified Data.Text.Prettyprint.Doc as Pretty @@ -50,6 +56,25 @@ instance Pretty Name where User n -> pretty n Path p -> pretty (show p) +reservedNames :: HashSet User +reservedNames = [ "#true", "#false", "let", "#frame", "if", "then", "else" + , "lexical", "import", "#unit", "load"] + +-- | Returns true if any character would require quotation or if the +-- name conflicts with a Core primitive. +needsQuotation :: User -> Bool +needsQuotation u = HashSet.member u reservedNames || any (not . isSimpleCharacter) u + +-- | A ‘simple’ character is, loosely defined, a character that is compatible +-- with identifiers in most ASCII-oriented programming languages. This is defined +-- as the alphanumeric set plus @$@ and @_@. +isSimpleCharacter :: Char -> Bool +isSimpleCharacter = \case + '$' -> True -- common in JS + '_' -> True + '?' -> True -- common in Ruby + c -> Char.isAlphaNum c + data Gensym = Root String | Gensym :/ (String, Int) diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs new file mode 100644 index 0000000000..72c6e79447 --- /dev/null +++ b/semantic-core/test/Generators.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Generators + ( literal + , name + , variable + , boolean + , lambda + , apply + , ifthenelse + ) where + +import Prelude hiding (span) + +import Hedgehog hiding (Var) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + +import Data.Core +import Data.Name + +-- The 'prune' call here ensures that we don't spend all our time just generating +-- fresh names for variables, since the length of variable names is not an +-- interesting property as they parse regardless. +name :: MonadGen m => m Name +name = Gen.prune (User <$> names) where + names = Gen.string (Range.linear 1 10) Gen.lower + +boolean :: MonadGen m => m Core +boolean = Bool <$> Gen.bool + +variable :: MonadGen m => m Core +variable = Var <$> name + +ifthenelse :: MonadGen m => m Core -> m Core +ifthenelse bod = Gen.subterm3 boolean bod bod If + +apply :: MonadGen m => m Core -> m Core +apply gen = go where + go = Gen.recursive + Gen.choice + [ Gen.subterm2 gen gen (:$)] + [ Gen.subterm2 go go (:$) -- balanced + , Gen.subtermM go (\x -> Lam <$> name <*> pure x) + ] + +lambda :: MonadGen m => m Core -> m Core +lambda bod = do + arg <- name + Gen.subterm bod (Lam arg) + +atoms :: MonadGen m => [m Core] +atoms = [boolean, variable, pure Unit, pure Frame] + +literal :: MonadGen m => m Core +literal = Gen.recursive Gen.choice atoms [lambda literal] diff --git a/semantic-core/test/Spec.hs b/semantic-core/test/Spec.hs new file mode 100644 index 0000000000..edc49efb0e --- /dev/null +++ b/semantic-core/test/Spec.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE OverloadedStrings, TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Main (main) where + +import Data.String +import qualified Text.Trifecta as Trifecta + +import Hedgehog hiding (Var) +import Test.Tasty +import Test.Tasty.Hedgehog +import Test.Tasty.HUnit + +import Data.File +import qualified Generators as Gen +import qualified Analysis.Eval as Eval +import Data.Core +import Data.Core.Pretty +import Data.Core.Parser as Parse +import Data.Name + +-- * Helpers + +true, false :: Core +true = Bool True +false = Bool False + +instance IsString Name where fromString = User + +parseEither :: Trifecta.Parser a -> String -> Either String a +parseEither p = Trifecta.foldResult (Left . show . Trifecta._errDoc) Right . Trifecta.parseString (p <* Trifecta.eof) mempty + +-- * Parser roundtripping properties. Note that parsing and prettyprinting is generally +-- not a roundtrip, because the parser inserts 'Ann' nodes itself. + +prop_roundtrips :: Gen Core -> Property +prop_roundtrips gen = property $ do + input <- forAll gen + tripping input showCore (parseEither (Parse.core <* Trifecta.eof)) + +parserProps :: TestTree +parserProps = testGroup "Parsing: roundtripping" + [ testProperty "literals" $ prop_roundtrips Gen.literal + , testProperty "if/then/else" . prop_roundtrips . Gen.ifthenelse $ Gen.variable + , testProperty "lambda" . prop_roundtrips $ Gen.lambda Gen.literal + , testProperty "function application" . prop_roundtrips $ Gen.apply Gen.variable + ] + +-- * Parser specs + +parsesInto :: String -> Core -> Assertion +parsesInto str res = case parseEither Parse.core str of + Right x -> x @?= res + Left m -> assertFailure m + +assert_booleans_parse :: Assertion +assert_booleans_parse = do + parseEither Parse.core "#true" @?= Right true + parseEither Parse.core "#false" @?= Right false + +a, f, g, h :: Core +(a, f, g, h) = (Var "a", Var "f", Var "g", Var "h") + +assert_ifthen_parse :: Assertion +assert_ifthen_parse = "if #true then #true else #false" `parsesInto` (If true true false) + +assert_application_parse :: Assertion +assert_application_parse ="f g" `parsesInto` (f :$ g) + +assert_application_left_associative :: Assertion +assert_application_left_associative = "f g h" `parsesInto` (f :$ g :$ h) + +assert_push_left_associative :: Assertion +assert_push_left_associative = "f.g.h" `parsesInto` (f :. g :. h) + +assert_ascii_lambda_parse :: Assertion +assert_ascii_lambda_parse = "\\a -> a" `parsesInto` Lam "a" a + +assert_unicode_lambda_parse :: Assertion +assert_unicode_lambda_parse = "λa → a" `parsesInto` Lam "a" a + +assert_quoted_name_parse :: Assertion +assert_quoted_name_parse = "#{(NilClass)}" `parsesInto` Var (User "(NilClass)") + +assert_let_dot_precedence :: Assertion +assert_let_dot_precedence = "let a = f.g.h" `parsesInto` (Let "a" := (f :. g :. h)) + +assert_let_in_push_precedence :: Assertion +assert_let_in_push_precedence = "f.let g = h" `parsesInto` (f :. (Let "g" := h)) + +parserSpecs :: TestTree +parserSpecs = testGroup "Parsing: simple specs" + [ testCase "true/false" assert_booleans_parse + , testCase "if/then/else" assert_ifthen_parse + , testCase "function application" assert_application_parse + , testCase "application is left-associative" assert_application_left_associative + , testCase "dotted push is left-associative" assert_push_left_associative + , testCase "lambda with ASCII syntax" assert_ascii_lambda_parse + , testCase "lambda with unicode syntax" assert_unicode_lambda_parse + , testCase "quoted names" assert_quoted_name_parse + , testCase "let + dot precedence" assert_let_dot_precedence + , testCase "let in push" assert_let_in_push_precedence + ] + +assert_roundtrips :: File Core -> Assertion +assert_roundtrips (File _ core) = parseEither Parse.core (showCore core) @?= Right (stripAnnotations core) + +parserExamples :: TestTree +parserExamples = testGroup "Parsing: Eval.hs examples" + [ testCase "prog1" (assert_roundtrips Eval.prog1) + , testCase "prog2" (assert_roundtrips Eval.prog2) + , testCase "prog3" (assert_roundtrips Eval.prog3) + , testCase "prog4" (assert_roundtrips Eval.prog4) + , testCase "prog6.1" (assert_roundtrips (head Eval.prog6)) + , testCase "prog6.2" (assert_roundtrips (last Eval.prog6)) + , testCase "ruby" (assert_roundtrips Eval.ruby) + ] + +tests :: TestTree +tests = testGroup "semantic-core" + [ parserSpecs + , parserExamples + , parserProps + ] + +main :: IO () +main = defaultMain tests