diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +### Version 0.1.2.0 + +* Add support for curly and square braces around S-Expressions +* Add unwrap utility for flattening nested S-Expressions + ### Version 0.1.1.0 Introduce mechanism for reading text as snail AST diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ ## Why? -My colleagues and I are going to start working through [Types and Progamming +My colleagues and I are going to start working through [Types and Programming Languages][tapl]. In the book you implement languages of varying feature sets. The book implements these languages in OCaml, however I had this Lisp parser essentially ready for awhile. There are a handful of "Write you a Scheme @@ -20,7 +20,7 @@ ## Is this really a programming language? -From the ["Programming language" wikipedia page][pl-wikipedia], +From the ["Programming language" Wikipedia page][pl-wikipedia], > A programming language is a system of notation for writing computer programs. @@ -68,23 +68,40 @@ ## Getting the AST -You can see some examples in `test/Snail/IOSpec.hs`, but you can put your snail -program into some file, let's say `hello.snail`. The following Haskell will print -the AST or print a failure, +You have two options: `readSnailFile` or `parseSnail`. -```haskell -module Main where +`readSnailFile` can be used like this, assuming you have put some valid snail +into a file `./hello.snail`, +```haskell import Snail -main :: IO () -main = do +printSnail :: IO () +printSnail = do eResults <- readSnailFile "./hello.snail" case eResults of Right ast -> print ast Left failureString -> print failureString ``` +`parseSnail` doesn't require `IO` the only parameter is `Text`. This is useful +for one-line programs, e.g., + +```haskell +{-# LANGUAGE OverloadedStrings #-} + +import Snail + +example :: Either String [SnailAst] +example = parseSnail "(print false)" +``` + +## Example Interpreters + +1. The `arith` language from [Types and Programming Languages][tapl]: https://github.com/chiroptical/snail-arith/blob/main/src/Lib.hs +2. Languages from [essentials-of-compilation][essentials-of-compilation]: https://github.com/chiroptical/essentials-of-compilation (each chapter is a module) + [tapl]: https://www.cis.upenn.edu/~bcpierce/tapl [haskell-parse-issue]: https://twitter.com/chiroptical/status/1471568781906518018 [pl-wikipedia]: https://en.wikipedia.org/wiki/Programming_language +[essentials-of-compilation]: https://mitpress.mit.edu/9780262047760/essentials-of-compilation diff --git a/snail.cabal b/snail.cabal --- a/snail.cabal +++ b/snail.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: snail -version: 0.1.1.0 +version: 0.1.2.0 synopsis: A programming language with no semantics description: An s-expression parser and abstract syntax tree for a programming language with no semantics. If you wanted to write an interpreter or compiler you convert the AST into your own. category: Parsing @@ -41,6 +41,7 @@ library exposed-modules: Snail + Snail.Ast Snail.Characters Snail.IO Snail.Lexer diff --git a/src/Snail.hs b/src/Snail.hs --- a/src/Snail.hs +++ b/src/Snail.hs @@ -2,6 +2,7 @@ module X, ) where +import Snail.Ast as X import Snail.Characters as X import Snail.IO as X import Snail.Lexer as X diff --git a/src/Snail/Ast.hs b/src/Snail/Ast.hs new file mode 100644 --- /dev/null +++ b/src/Snail/Ast.hs @@ -0,0 +1,62 @@ +module Snail.Ast ( + -- * Constructors for AST + Bracket (..), + SnailAst (..), +) where + +import Data.Text (Text) +import Text.Megaparsec + +-- | The bracket used to surround the s-expression +data Bracket + = Round + | Square + | Curly + deriving (Show, Eq) + +{- + A possibly empty tree of s-expressions + + Technically, + @ + Token (SourcePos {..}, "hello") + @ + + isn't a valid s-expression. This is, + + @ + SExpression [Token (SourcePos {..}, "hello")] + @ + + and this is also valid, + + @ + SExpression [] + @ + + The 'Data.Tree.Tree' type in containers is non-empty which isn't exactly what we are looking for +-} +data SnailAst + = Lexeme (SourcePos, Text) + | TextLiteral (SourcePos, Text) + | SExpression (Maybe Char) Bracket [SnailAst] + deriving (Eq, Show) + +{- | Unwrap nested s-expressions, this is very useful when you are converting +'SnailAst' to your own AST. + +You'll likely have a function `snailAstToMyAst :: SnailAst -> m MyAst` where +`m` is `ExceptT` or `MonadExcept`. Then, your final case statement should +unwrap nested expressions to their base with, + +@ +snailAstToMyAst . unwrap . SExpression initialChar bracket $ unwrap <$> exprs` +@ + +For example, `((read))` will become `SExpression _ _ [Lexeme (_, "read")]` +which your AST converter should handle. +-} +unwrap :: SnailAst -> SnailAst +unwrap = \case + SExpression _ _ [x] -> x + x -> x diff --git a/src/Snail/Characters.hs b/src/Snail/Characters.hs --- a/src/Snail/Characters.hs +++ b/src/Snail/Characters.hs @@ -1,25 +1,17 @@ -module Snail.Characters where - --- | The initial character of any text -initialCharacter :: String -initialCharacter = ['a' .. 'z'] <> ['A' .. 'Z'] - --- | ... -specialInitialCharacter :: String -specialInitialCharacter = "!$%&*/:<=>?^_~#,'" +module Snail.Characters (validCharacter, parenthesisStartingCharacter) where --- | ... -peculiarCharacter :: String -peculiarCharacter = "+-." +-- | The valid character set of Snail +validCharacter :: String +validCharacter = ['a' .. 'z'] <> ['A' .. 'Z'] <> digitCharacter <> specialInitialCharacter --- | ... +-- | Characters allowed in numbers digitCharacter :: String digitCharacter = ['0' .. '9'] --- | ... -specialSubsequentCharacter :: String -specialSubsequentCharacter = "+-.@\\" +-- | Special initial characters +specialInitialCharacter :: String +specialInitialCharacter = "!$%&*/:=?^_~#,'+-.@\\<>" --- | ... +-- | Characters allowed in front of an s-expression parenthesisStartingCharacter :: String parenthesisStartingCharacter = "'`@#," diff --git a/src/Snail/IO.hs b/src/Snail/IO.hs --- a/src/Snail/IO.hs +++ b/src/Snail/IO.hs @@ -3,6 +3,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Text.IO qualified as Text +import Snail.Ast import Snail.Lexer import Text.Megaparsec diff --git a/src/Snail/Lexer.hs b/src/Snail/Lexer.hs --- a/src/Snail/Lexer.hs +++ b/src/Snail/Lexer.hs @@ -7,9 +7,9 @@ Here, we implement a structurally aware lexer that supports one token type (text literals) for convenience. -} +{-# LANGUAGE TupleSections #-} + module Snail.Lexer ( - -- * The parsers you should use - SnailAst (..), sExpression, snailAst, @@ -21,6 +21,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Void +import Snail.Ast import Snail.Characters import Text.Megaparsec hiding (token) import Text.Megaparsec.Char @@ -51,49 +52,18 @@ symbol :: Text -> Parser Text symbol = L.symbol spaces --- | Parse an S-Expression -parens :: Parser a -> Parser a -parens = between (symbol "(") (symbol ")") - -{- | The list of valid token characters, note that we allow invalid tokens at - this point --} -validCharacter :: Parser Char -validCharacter = - oneOf - ( initialCharacter - <> specialInitialCharacter - <> digitCharacter - <> specialSubsequentCharacter - ) - -{- - A possibly empty tree of s-expressions - - Technically, - @ - Token (SourcePos {..}, "hello") - @ - - isn't a valid s-expression. This is, - - @ - SExpression [Token (SourcePos {..}, "hello")] - @ +roundP :: Parser a -> Parser (Bracket, a) +roundP = fmap (Round,) . between (symbol "(") (symbol ")") - and this is also valid, +square :: Parser a -> Parser (Bracket, a) +square = fmap (Square,) . between (symbol "[") (symbol "]") - @ - SExpression [] - @ +curly :: Parser a -> Parser (Bracket, a) +curly = fmap (Curly,) . between (symbol "{") (symbol "}") - The 'Data.Tree.Tree' type in containers is non-empty which isn't exactly what we are looking for --} -data SnailAst - = Lexeme (SourcePos, Text) - | TextLiteral (SourcePos, Text) - | SExpression (Maybe Char) [SnailAst] - deriving (Eq, Show) +-- | Parse an S-Expression bracketed by 'Bracket' +bracket :: Parser a -> Parser (Bracket, a) +bracket inp = roundP inp <|> square inp <|> curly inp {- | Any 'Text' object that starts with an appropriately valid character. This could be an variable or function name. For example, `hello` is a valid @@ -106,8 +76,8 @@ lexeme :: Parser SnailAst lexeme = do sourcePosition <- getSourcePos - lexeme' <- some validCharacter - pure $ Lexeme (sourcePosition, Text.pack lexeme') + txt <- some $ oneOf validCharacter + pure $ Lexeme (sourcePosition, Text.pack txt) -- | An escaped quote to support nesting `"` inside a 'textLiteral' escapedQuote :: Parser Text @@ -135,7 +105,7 @@ textLiteral = do sourcePosition <- getSourcePos mText <- quotes . optional $ some $ escapedQuote <|> nonQuoteCharacter - notFollowedBy (validCharacter <|> char '\"') + notFollowedBy (oneOf validCharacter <|> char '\"') pure $ case mText of Nothing -> TextLiteral (sourcePosition, "") Just text -> TextLiteral (sourcePosition, Text.concat text) @@ -148,10 +118,10 @@ -- | Parse an 'SExpression' sExpression :: Parser SnailAst -sExpression = - SExpression - <$> optional (oneOf parenthesisStartingCharacter) - <*> parens (leaves `sepEndBy` spaces) +sExpression = do + startingChar <- optional (oneOf parenthesisStartingCharacter) + (bracketType, expr) <- bracket (leaves `sepEndBy` spaces) + pure $ SExpression startingChar bracketType expr -- | Parse a valid snail file snailAst :: Parser [SnailAst] diff --git a/src/Snail/ToText.hs b/src/Snail/ToText.hs --- a/src/Snail/ToText.hs +++ b/src/Snail/ToText.hs @@ -1,15 +1,21 @@ module Snail.ToText (toText) where import Data.Text -import Snail.Lexer +import Snail.Ast +bracket :: Text -> Bracket -> Text +bracket txt = \case + Round -> "(" <> txt <> ")" + Square -> "[" <> txt <> "]" + Curly -> "{" <> txt <> "}" + toText :: SnailAst -> Text toText = \case TextLiteral (_, txt) -> "\"" <> txt <> "\"" Lexeme (_, lexeme) -> lexeme - SExpression Nothing exprs -> + SExpression Nothing bracketKind exprs -> let txt = Data.Text.unwords $ toText <$> exprs - in "(" <> txt <> ")" - SExpression (Just c) exprs -> + in bracket txt bracketKind + SExpression (Just c) bracketKind exprs -> let txt = Data.Text.unwords $ toText <$> exprs - in singleton c <> "(" <> txt <> ")" + in singleton c <> bracket txt bracketKind diff --git a/test/Snail/LexerSpec.hs b/test/Snail/LexerSpec.hs --- a/test/Snail/LexerSpec.hs +++ b/test/Snail/LexerSpec.hs @@ -7,7 +7,7 @@ import Snail import Test.HUnit (assertBool) import Test.Hspec -import Text.Megaparsec (parseMaybe) +import Text.Megaparsec (parseMaybe, parseTest) import Text.RawString.QQ foldLexemes :: SnailAst -> [Text] @@ -16,8 +16,8 @@ go :: [Text] -> SnailAst -> [Text] go acc (Lexeme (_, t)) = acc ++ [t] go acc (TextLiteral (_, t)) = acc ++ [t] - go acc (SExpression _ []) = acc - go acc (SExpression _ (x : xs)) = lgo (go acc x) xs + go acc (SExpression _ _ []) = acc + go acc (SExpression _ _ (x : xs)) = lgo (go acc x) xs lgo :: [Text] -> [SnailAst] -> [Text] lgo acc [] = acc lgo acc (x : xs) = lgo (go acc x) xs @@ -28,7 +28,7 @@ sExpressionShouldBe :: Text -> [Text] -> Expectation sExpressionShouldBe input output = case parseMaybe sExpression input of - Nothing -> failAssertion "sExpressionShouldBe: Nothing" + Nothing -> failAssertion $ "sExpressionShouldBe: " <> unpack input Just sExpr -> do let lexemes = foldLexemes sExpr lexemes `shouldBe` output @@ -79,10 +79,11 @@ let mSExpr = parseMaybe sExpression "nil" mSExpr `shouldSatisfy` isNothing - it "successfully lex a basic list" $ do + it "successfully lex a basic list with number" $ do + parseTest sExpression "(1 a)" "(1 a)" `sExpressionShouldBe` ["1", "a"] - it "successfully lex a basic list with starting character" $ do + it "successfully lex a basic list with number and starting character" $ do "'(1 a)" `sExpressionShouldBe` ["1", "a"] it "successfully lex a single element list" $ do @@ -91,12 +92,24 @@ it "successfully lex a nested s-expression" $ do "((1a))" `sExpressionShouldBe` ["1a"] + it "successfully lex a nested s-expression with different brackets" $ do + "([1a])" `sExpressionShouldBe` ["1a"] + it "successfully lex nested s-expressions" $ do "(() ())" `sExpressionShouldBe` [] + it "successfully lex nested s-expressions of each bracket" $ do + "(() [] {})" `sExpressionShouldBe` [] + + it "successfully lex internally nested s-expressions of each bracket" $ do + "([{}])" `sExpressionShouldBe` [] + it "successfully lex a nested s-expressions" $ do "((()) (()))" `sExpressionShouldBe` [] + it "successfully lex a nested s-expressions of different brackets" $ do + "({()} [{}])" `sExpressionShouldBe` [] + it "successfully lex line comment" $ do "(-- ...\n)" `sExpressionShouldBe` [] @@ -144,3 +157,6 @@ it "handles successive text literals" $ do [r|("hello" " " "world" "!!!")|] `sExpressionShouldBe` ["hello", " ", "world", "!!!"] + + it "fails to parse nested mismatched brackets" $ do + parseMaybe snailAst "([)]" `shouldSatisfy` isNothing diff --git a/test/Snail/ToTextSpec.hs b/test/Snail/ToTextSpec.hs --- a/test/Snail/ToTextSpec.hs +++ b/test/Snail/ToTextSpec.hs @@ -11,14 +11,15 @@ spec = do describe "toText" $ do it "handles empty s-expression" $ - toText (SExpression Nothing []) `shouldBe` "()" + toText (SExpression Nothing Round []) `shouldBe` "()" it "handles basic text literal" $ - toText (SExpression Nothing [TextLiteral (sourcePos, "hello world")]) + toText (SExpression Nothing Round [TextLiteral (sourcePos, "hello world")]) `shouldBe` [r|("hello world")|] it "handles basic lexeme" $ toText ( SExpression Nothing + Round [ Lexeme (sourcePos, "hello") , Lexeme (sourcePos, "world") ]