Merge branch 'megaparsec'

README.md

@@ -1,5 +1,9 @@
 # Violet
 
+## Dev Guide
+
+[Megaparsec guide](https://markkarpov.com/tutorial/megaparsec.html#parsect-and-parsec-monads)
+
 ## Stack Guide
 
 ### Install Dependencies
@@ -7,3 +11,8 @@
 1. `stack.yaml`: add `package-name-version` to `extra-deps`
 2. `package.yaml`: add `package-name` to `dependencies`
 3. run `stack build`
+
+### Run GHCI
+
+1. run `stack ghci`
+2. run `:set -XOverloadedStrings` in GHCI

app/Main.hs

@@ -1,15 +1,85 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Main (main) where
 
-import Parser (parseFile)
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Parser (Parser, parseProgram)
+import System.Environment (getArgs)
+import Text.Megaparsec (errorBundlePretty, parse)
 
-process :: String -> IO ()
-process line = do
-  let res = parseFile line
-  case res of
-    Left err -> print err
-    Right ex -> mapM_ print ex
+-- GHCI test inputs
+
+file :: Text
+file =
+  "---\n\
+  \Here is a brief sample of the\n\
+  \language and its syntax\n\
+  \---\n\
+  \\n\
+  \-- Import statements\n\
+  \import std.collections {\n\
+  \    Heap,\n\
+  \    HashMap,\n\
+  \}\n\
+  \\n\
+  \-- Function declaration with types\n\
+  \fn fizz-buzz(i: Num): Str {\n\
+  \    --- This is technically a legal comment ---\n\
+  \    let fb = \"\";\n\
+  \\n\
+  \    if i % 3 == 0 {\n\
+  \        fb = fb ++ \"fizz\";\n\
+  \    }\n\
+  \\n\
+  \    if i % 5 == 0 {\n\
+  \        fb ++= \"buzz\";\n\
+  \    }\n\
+  \\n\
+  \    return i if Str.is-empty(fb) else fb;\n\
+  \}\n\
+  \\n\
+  \-- Function declaration without types\n\
+  \fn main() {\n\
+  \    const fb: Str = fizz-buzz();\n\
+  \    print(fb);\n\
+  \}"
+
+blockComment :: Text
+blockComment =
+  "---\n\
+  \Here is a brief sample of the\n\
+  \language and its syntax\n\
+  \---"
+
+singleBlockComment :: Text
+singleBlockComment = "--- This is technically a legal comment ---"
+
+singleComment :: Text
+singleComment = "-- Import statements"
+
+importStatement :: Text
+importStatement =
+  "import std.collections {\n\
+  \    Heap,\n\
+  \    HashMap,\n\
+  \}"
+
+-- Runners
+
+printParser :: (Show s) => Parser s -> Text -> IO ()
+printParser parser input = case parse parser "" input of
+  Left err -> putStrLn $ errorBundlePretty err
+  Right result -> print result
+
+parseFile :: FilePath -> IO ()
+parseFile filePath = do
+  input <- TIO.readFile filePath
+  printParser parseProgram input
 
 main :: IO ()
 main = do
-  fileText <- readFile "test.vi"
-  process fileText
+  args <- getArgs
+  case args of
+    [filePath] -> parseFile filePath
+    _ -> putStrLn "Usage: programName filePath"

package.yaml

@@ -21,8 +21,8 @@ description:         Please see the README on GitHub at <https://github.com/zyrr
 
 dependencies:
 - base >= 4.7 && < 5
-- parsec
-- parsec-numbers
+- megaparsec
+- text
 
 ghc-options:
 - -Wall

src/Lexer.hs

@@ -1,61 +1 @@
-module Lexer
-  ( integer,
-    float,
-    parens,
-    braces,
-    commaSep,
-    dotSep,
-    identifier,
-    reserved,
-    reservedOp,
-    lexer,
-  )
-where
-
-import Text.Parsec (alphaNum, char, letter, sepBy, (<|>))
-import Text.Parsec.Language (emptyDef)
-import Text.Parsec.String (Parser)
-import qualified Text.Parsec.Token as Token
-
-lexer :: Token.TokenParser ()
-lexer = Token.makeTokenParser languageDef
-  where
-    reservedOps = ["+", "*", "-", "%", "/", "++", "=", "==", ":", ";"]
-    reservedKeywords = ["import", "fn", "let", "if", "extern"]
-    languageDef =
-      emptyDef
-        { Token.commentLine = "--",
-          Token.commentStart = "---",
-          Token.commentEnd = "---",
-          Token.identStart = letter <|> char '-',
-          Token.identLetter = alphaNum <|> char '-',
-          Token.reservedOpNames = reservedOps,
-          Token.reservedNames = reservedKeywords
-        }
-
-integer :: Parser Integer
-integer = Token.integer lexer
-
-float :: Parser Double
-float = Token.float lexer
-
-parens :: Parser a -> Parser a
-parens = Token.parens lexer
-
-braces :: Parser a -> Parser a
-braces = Token.braces lexer
-
-commaSep :: Parser a -> Parser [a]
-commaSep = Token.commaSep lexer
-
-dotSep :: Parser a -> Parser [a]
-dotSep p = sepBy p (Token.dot lexer)
-
-identifier :: Parser String
-identifier = Token.identifier lexer
-
-reserved :: String -> Parser ()
-reserved = Token.reserved lexer
-
-reservedOp :: String -> Parser ()
-reservedOp = Token.reservedOp lexer
+module Lexer where

src/Parser.hs

@@ -1,91 +1,102 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
 module Parser where
 
-import Data.Functor.Identity (Identity)
-import Lexer
-import Syntax
-  ( Expr (BinOp, Float, FunctionCall, FunctionDef, Import, Int, Var),
-    Op (Divide, Minus, Plus, Times),
-  )
-import Text.Parsec
-import qualified Text.Parsec.Expr as Ex
-import Text.Parsec.String (Parser)
-import Text.Parsec.Token (GenTokenParser (symbol))
-import qualified Text.Parsec.Token as Token
+import Control.Applicative hiding (many, some)
+import Control.Monad
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Void
+import Text.Megaparsec hiding (State)
+import Text.Megaparsec.Char
+import qualified Text.Megaparsec.Char.Lexer as L
 
-binary :: String -> Syntax.Op -> Ex.Assoc -> Ex.Operator String () Identity Syntax.Expr
-binary s f = Ex.Infix (reservedOp s >> return (Syntax.BinOp f))
+type Parser = Parsec Void Text
 
-table :: [[Ex.Operator String () Identity Syntax.Expr]]
-table =
-  [ [ binary "*" Times Ex.AssocLeft,
-      binary "/" Divide Ex.AssocLeft
-    ],
-    [ binary "+" Plus Ex.AssocLeft,
-      binary "-" Minus Ex.AssocLeft
-    ]
-  ]
+newtype Program = Program
+  { statements :: [Statement]
+  }
+  deriving (Show)
 
-int :: Parser Syntax.Expr
-int = Syntax.Int <$> integer
+data Statement
+  = Import [Identifier] [Identifier]
+  | Expr Expression
+  | Function Identifier [Identifier] Block
+  | Return Expression
+  | Conditional Expression Block (Maybe Block)
+  deriving (Show)
 
-floating :: Parser Syntax.Expr
-floating = Syntax.Float <$> float
+data Expression = E deriving (Show)
 
-expr :: Parser Syntax.Expr
-expr = Ex.buildExpressionParser table factor
+type Block = [Statement]
 
-variable :: Parser Syntax.Expr
-variable = Syntax.Var <$> identifier
+type Identifier = String
 
-call :: Parser Syntax.Expr
-call = do
-  name <- identifier
-  args <- parens $ commaSep expr
-  return $ FunctionCall name args
+parseProgram :: Parser Program
+parseProgram = program <* eof
+  where
+    program = do
+      void $ many space
+      statements <- parseStatements
+      return Program {..}
 
-factor :: Parser Syntax.Expr
-factor =
-  try floating
-    <|> try int
-    -- <|> try function
-    <|> try call
-    <|> variable
-    <|> parens expr
+parseStatements :: Parser [Statement]
+parseStatements =
+  many $ do
+    void parseComment
+    choice
+      [ try parseImport
+      -- try parseExpression,
+      -- try parseFunction,
+      -- try parseReturn,
+      -- try parseConditional
+      ]
 
---
+-- Misc
 
-parseFile :: String -> Either ParseError [Syntax.Expr]
-parseFile = parse (fileContents topLevel) "<stdin>"
+parseIdentifier :: Parser Identifier
+parseIdentifier = some alphaNumChar
 
-fileContents :: Parser a -> Parser a
-fileContents p = do
-  Token.whiteSpace lexer
-  r <- p
-  eof
-  return r
+-- Comments
 
-topLevel :: Parser [Syntax.Expr]
-topLevel =
-  many $
-    try importDef
-      <|> try functionDef
+parseComment :: Parser Text
+parseComment = choice [try parseBlockComment, try parseSingleComment]
 
---   <|> try functionCall
+parseSingleComment :: Parser Text
+parseSingleComment = do
+  _ <- string "--"
+  takeWhileP Nothing (/= '\n')
 
-importDef :: Parser Syntax.Expr
-importDef = do
-  reserved "import"
-  scope <- dotSep identifier
-  imports <- braces $ commaSep identifier
-  return $ Import scope imports
+parseBlockComment :: Parser Text
+parseBlockComment = do
+  _ <- string "---"
+  body <- manyTill anySingle (string "---")
+  return $ T.pack body
 
-functionDef :: Parser Syntax.Expr
-functionDef = do
-  reserved "fn"
-  name <- identifier
-  args <- parens $ commaSep variable
-  body <- block
-  return $ Syntax.FunctionDef name args body
+-- Imports
 
-block :: Parser [Syntax.Expr]
-block = braces $ many expr
+parseImport :: Parser Statement
+parseImport = do
+  void $ string "import"
+  space1
+  modulePath <- sepBy1 parseIdentifier (char '.')
+  space1
+  importedItems <- between startBlock endBlock $ sepEndBy parseIdentifier itemSep
+  return $ Import modulePath importedItems
+  where
+    startBlock = char '{' <* space
+    endBlock = space *> char '}'
+    itemSep = space *> char ',' <* space
+
+-- parseExpression :: Parser Statement
+-- parseExpression = undefined
+
+-- parseFunction :: Parser Statement
+-- parseFunction = undefined
+
+-- parseReturn :: Parser Statement
+-- parseReturn = undefined
+
+-- parseConditional :: Parser Statement
+-- parseConditional = undefined

src/Syntax.hs

@@ -1,20 +1 @@
-module Syntax (Name, Expr (..), Op (..)) where
-
-type Name = String
-
-data Expr
-  = Int Integer
-  | Float Double
-  | BinOp Op Expr Expr
-  | Var String
-  | FunctionCall Name [Expr]
-  | FunctionDef Name [Expr] [Expr]
-  | Import [Name] [Name]
-  deriving (Eq, Ord, Show)
-
-data Op
-  = Plus
-  | Minus
-  | Times
-  | Divide
-  deriving (Eq, Ord, Show)
+module Syntax where

stack.yaml

@@ -41,8 +41,8 @@ packages:
 #   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
 #
 extra-deps: 
-- parsec-3.1.16.1
-- parsec-numbers-0.1.0
+- megaparsec-9.6.1
+# - text-2.0.2
 
 # Override default flag values for local packages and extra-deps
 # flags: {}

stack.yaml.lock

@@ -5,19 +5,12 @@
 
 packages:
 - completed:
-    hackage: parsec-3.1.16.1@sha256:5769242043b01bf759b07b7efedcb19607837ee79015fcddde34645664136aed,4691
+    hackage: megaparsec-9.6.1@sha256:8d8f8ee5aca5d5c16aa4219afd13687ceab8be640f40ba179359f2b42a628241,3323
     pantry-tree:
-      sha256: aee875443fc603500dcfcb5bea5c116ebcb990037abcf17e8d7020e493a51476
-      size: 2698
+      sha256: ac654040a2402a733496678905ee17198bf628d75032dd025d595bd329739af8
+      size: 1545
   original:
-    hackage: parsec-3.1.16.1
-- completed:
-    hackage: parsec-numbers-0.1.0@sha256:60fa05b1c16050dffd0e28cecb682a021eeec1be6f34dc9d901a38c90182f289,727
-    pantry-tree:
-      sha256: 436569c1d85f65785085f9f58ca44064001fb6f68b5cfe30670574ba45644f4c
-      size: 281
-  original:
-    hackage: parsec-numbers-0.1.0
+    hackage: megaparsec-9.6.1
 snapshots:
 - completed:
     sha256: 2fdd7d3e54540062ef75ca0a73ca3a804c527dbf8a4cadafabf340e66ac4af40

violet.cabal

@@ -37,8 +37,8 @@ library
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
       base >=4.7 && <5
-    , parsec
-    , parsec-numbers
+    , megaparsec
+    , text
   default-language: Haskell2010
 
 executable violet-exe
@@ -52,8 +52,8 @@ executable violet-exe
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
-    , parsec
-    , parsec-numbers
+    , megaparsec
+    , text
     , violet
   default-language: Haskell2010
 
@@ -69,7 +69,7 @@ test-suite violet-test
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
-    , parsec
-    , parsec-numbers
+    , megaparsec
+    , text
     , violet
   default-language: Haskell2010