wip: redoing parser

lib/Ast/Parser.hs

@@ -1,83 +1,76 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeFamilies #-}
-
 module Ast.Parser (parse) where
 
-import qualified Ast.Tokenizer as T
-import Ast.Types (AST (..), Expr)
-import Control.Applicative (Alternative ((<|>)))
-import Data.Foldable (Foldable (toList))
+import Ast.Types (AST (..), Expr (..), Literal (..), Operation (..))
+import Control.Applicative (Alternative (..))
 import qualified Data.Void as V
 import qualified Text.Megaparsec as M
-import qualified Text.Megaparsec.State as MST
-import qualified Text.Megaparsec.Stream as MS
-
-newtype TokenStream = TokenStream [T.Token]
-  deriving (Show, Eq, Ord)
+import qualified Text.Megaparsec.Char as MC
+import qualified Text.Megaparsec.Char.Lexer as ML
 
-instance MS.Stream TokenStream where
-  type Token TokenStream = T.Token
-  type Tokens TokenStream = [T.Token]
+type Parser = M.Parsec V.Void String
 
-  tokenToChunk _ t = [t]
+parse :: String -> Either String AST
+parse input = case M.parse parseProgram "" input of
+  Left err -> Left (M.errorBundlePretty err)
+  Right tokens -> Right tokens
 
-  tokensToChunk _ ts = ts
+parseProgram :: Parser AST
+parseProgram = do
+  ast <- parseAst
+  M.eof
+  return ast
 
-  chunkToTokens _ chunk = chunk
+parseAst :: Parser AST
+parseAst =
+  lexeme $
+    let parsers = [parseDefine, parseLambda, parseIf, parseCall, parseOp, parseVar, parseLit]
+        triedParsers = map M.try (init parsers) ++ [last parsers]
+     in M.choice triedParsers
 
-  chunkLength _ = length
+parseLit :: Parser AST
+parseLit = AST . (: []) . Lit <$> M.choice [parseInt, parseBool]
 
-  chunkEmpty _ = null
+parseInt :: Parser Literal
+parseInt = LInt <$> ML.signed sc ML.decimal
 
-  take1_ (TokenStream []) = Nothing
-  take1_ (TokenStream (x : xs)) = Just (x, TokenStream xs)
+parseBool :: Parser Literal
+parseBool = LBool True <$ MC.string "#t" <|> LBool False <$ MC.string "#f"
 
-  takeN_ n (TokenStream s)
-    | null s = Nothing
-    | n <= 0 = Just ([], TokenStream s)
-    | otherwise = Just (take n s, TokenStream $ drop n s)
+parseVar :: Parser AST
+parseVar = AST . (: []) . Var <$> some (MC.alphaNumChar <|> MC.symbolChar <|> M.oneOf "+-*_")
 
-  takeWhile_ f (TokenStream s) =
-    let (h, t) = span f s
-     in (h, TokenStream t)
+parseDefine :: Parser AST
+parseDefine = fail ""
 
-instance MS.VisualStream TokenStream where
-  showTokens _ ts = unwords $ map show $ toList ts
+parseCall :: Parser AST
+parseCall = fail ""
 
-instance MS.TraversableStream TokenStream where
-  reachOffset o pst =
-    let (TokenStream s) = MST.pstateInput pst
-        oldOffset = MST.pstateOffset pst
-        diff = o - oldOffset
-        (_, rest) = splitAt diff s
-        newPosState =
-          pst
-            { MST.pstateInput = TokenStream rest,
-              MST.pstateOffset = o
-            }
-        shownStream = show (take 10 rest)
-     in (Just shownStream, newPosState)
+parseLambda :: Parser AST
+parseLambda = fail ""
 
-type Parser = M.Parsec V.Void TokenStream
+parseIf :: Parser AST
+parseIf = do
+  _ <- MC.string "if" <* sc
+  e1 <- parseAst <* sc
+  e2 <- parseAst <* sc
+  e3 <- parseAst
+  return $ AST . (: []) $ If e1 e2 e3
 
-parse :: String -> Either String AST
-parse input = case T.tokenize input of
-  Left err -> Left err
-  Right tokens -> case M.parse parseProgram "" (TokenStream tokens) of
-    Left err -> Left (M.errorBundlePretty err)
-    Right ast -> Right ast
+parseOp :: Parser AST
+parseOp = do
+  op <- parseOpeartor <* sc
+  e1 <- parseAst <* sc
+  e2 <- parseAst
+  return $ AST . (: []) $ Op op e1 e2
 
-parseProgram :: Parser AST
-parseProgram = do
-  exprs <- M.many parseExpr
-  M.eof
-  return $ AST exprs
+parseOpeartor :: Parser Operation
+parseOpeartor = M.choice $ (\(o, c) -> c <$ MC.string o) <$> ops
 
-parseExpr :: Parser Expr
-parseExpr = parseAtom <|> parseList
+ops :: [(String, Operation)]
+ops = [("+", Add), ("-", Sub), ("*", Mult), ("div", Div), (">", Gt), ("<", Lt), (">=", Gte), ("<=", Lte), ("==", Equal), ("&&", And), ("||", Or)]
 
-parseAtom :: Parser Expr
-parseAtom = fail "not defined"
+sc :: Parser ()
+sc = ML.space MC.space1 empty empty
 
-parseList :: Parser Expr
-parseList = fail "not defined"
+lexeme :: Parser a -> Parser a
+lexeme = ML.lexeme sc

lib/Ast/Types.hs

@@ -17,11 +17,11 @@ data Literal
 data Expr
   = Lit Literal
   | Var String
-  | Define String Expr
-  | Call Expr [Expr]
-  | Lambda [String] Expr
-  | If Expr Expr Expr
-  | Op Operation Expr Expr
+  | Define String AST
+  | Call AST [AST]
+  | Lambda [String] AST
+  | If AST AST AST
+  | Op Operation AST AST
   deriving (Show, Eq)
 
 -- | Operations supported by the language, such as addition, subtraction, etc.