diff options
author | Juan J. Martinez <jjm@usebox.net> | 2022-09-07 16:26:50 +0100 |
---|---|---|
committer | Juan J. Martinez <jjm@usebox.net> | 2022-09-07 16:26:50 +0100 |
commit | 65c8beecb14f6d09c49504d74beedd58cc7ddd17 (patch) | |
tree | 0a39cc6fc3f78153272c6528300936c039351d3e /src/Micro/Parser.hs | |
parent | 48896c56c39344fa429260d3969eccc93ef8035c (diff) | |
download | micro-lang-hs-65c8beecb14f6d09c49504d74beedd58cc7ddd17.tar.gz micro-lang-hs-65c8beecb14f6d09c49504d74beedd58cc7ddd17.zip |
Better project layout, removed warnings
Diffstat (limited to 'src/Micro/Parser.hs')
-rw-r--r-- | src/Micro/Parser.hs | 223 |
1 files changed, 223 insertions, 0 deletions
diff --git a/src/Micro/Parser.hs b/src/Micro/Parser.hs new file mode 100644 index 0000000..ea4873e --- /dev/null +++ b/src/Micro/Parser.hs @@ -0,0 +1,223 @@ +module Micro.Parser where + +import Control.Monad.Identity (Identity) +import Data.Maybe (isJust) +import Micro.Ast +import Micro.Lexer +import Text.Parsec +import qualified Text.Parsec.Expr as E +import Text.Parsec.String (Parser) + +binary :: String -> Op -> E.Assoc -> E.Operator String () Identity Expr +binary s f assoc = + E.Infix + ( reservedOp s + >> do + pos <- getPosition + return $ BinOp f pos + ) + assoc + +opTable :: [[E.Operator String () Identity Expr]] +opTable = + [ [binary "=" Assign E.AssocLeft], + [ binary "*" Mul E.AssocLeft, + binary "/" Div E.AssocLeft + ], + [ binary "+" Plus E.AssocLeft, + binary "-" Minus E.AssocLeft + ] + ] + +expr :: Parser Expr +expr = E.buildExpressionParser opTable factor + +number :: Parser Expr +number = do + pos <- getPosition + n <- integer + return $ Num n pos + +true :: Parser Expr +true = do + pos <- getPosition + reserved "true" + return $ Bool' True pos + +false :: Parser Expr +false = do + pos <- getPosition + reserved "false" + return $ Bool' False pos + +variable :: Parser Expr +variable = do + pos <- getPosition + var <- identifier + return $ Variable var pos + +typ :: Parser Type +typ = do + p <- identifier + return $ Type p + +typFn :: Parser Type +typFn = do + p <- parens $ commaSep typ + r <- optionMaybe $ do + reserved "->" + typ + return $ FuncType p r + +type' :: Parser Type +type' = do + try typFn + <|> typ <?> "type" + +-- argument +arg :: Parser (String, Type, Bool, SourcePos) +arg = do + pos <- getPosition + i <- identifier + _ <- colonSep <?> "\":\" before type" + t <- type' <?> "type" + return $ (i, t, True, pos) + +-- function definition (common to def and lambda) +fdef :: Ident -> Bool -> Bool -> SourcePos -> Parser Expr +fdef ident priv anon pos = do + args <- parens $ commaSep arg + rtyp <- + optionMaybe + ( do + _ <- colonSep <?> "\":\" before type" + rtyp <- type' <?> "return type" + return $ rtyp + ) + body <- + braces $ + many $ + do + x <- fStatement + pure $ [x] + <|> grVar True + return $ Func ident args rtyp (concat $ body) priv anon pos + +function :: Bool -> Parser Expr +function priv = do + pos <- getPosition + reserved "def" + ident <- identifier + fdef ident priv False pos + +-- ident: type = value +varWithValue :: Bool -> Parser Expr +varWithValue priv = do + (ident, typ, _, pos) <- arg + reservedOp "=" <?> "assignation" + value <- expr + return $ Var ident typ value priv pos + +-- group variable declaration +grVar :: Bool -> Parser [Expr] +grVar priv = do + reserved "var" + xs <- parens $ commaSep $ varWithValue priv + reservedOp ";" + return $ xs + +-- variable declaration +var :: Bool -> Parser Expr +var priv = do + reserved "var" + x <- varWithValue priv + reservedOp ";" + return $ x + +-- private definition +privateDf :: (Bool -> Parser Expr) -> Parser Expr +privateDf f = do + priv <- optionMaybe $ reserved "private" + f (isJust priv) + +-- private group definition +privateDfn :: (Bool -> Parser [Expr]) -> Parser [Expr] +privateDfn f = do + priv <- optionMaybe $ reserved "private" + f (isJust priv) + +lambdaId :: SourcePos -> Ident +lambdaId s = + "lambda" ++ "@" ++ show (sourceLine s) ++ "," ++ show (sourceColumn s) + +lambda :: Parser Expr +lambda = do + pos <- getPosition + fdef (lambdaId pos) True True pos + +return' :: Parser Expr +return' = do + pos <- getPosition + reserved "return" + value <- optionMaybe expr + reservedOp ";" + return $ Return value pos + +call :: Parser Expr +call = do + pos <- getPosition + ident <- try lambda <|> variable + args <- parens $ commaSep expr + return $ Call ident args pos + +factor :: Parser Expr +factor = + number + <|> true + <|> false + <|> try call + <|> try lambda + <|> try variable + <|> parens expr + +exprStmt :: Parser Expr +exprStmt = do + e <- expr <|> factor + reservedOp ";" + return $ e + +-- statements that appear in functions +fStatement :: Parser Expr +fStatement = try exprStmt <|> var True <|> return' + +-- top level statement +statement :: Parser Expr +statement = + try exprStmt <|> try (privateDf var) + <|> return' -- this will raise an error + +module' :: Parser Expr +module' = do + pos <- getPosition + reserved "module" + ident <- identifier + return $ Module ident pos + +program :: Parser [Expr] +program = do + m <- module' + n <- + many $ + do + x <- try (privateDf function) <|> statement + pure $ [x] + <|> privateDfn grVar + return $ [m] ++ (concat $ n) + +parse :: Parser [Expr] +parse = program + +parseFromFile :: Parsec String () a -> FilePath -> IO (Either ParseError a) +parseFromFile p fname = do + input <- readFile fname + return (runParser p () fname input) |