From 65c8beecb14f6d09c49504d74beedd58cc7ddd17 Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Wed, 7 Sep 2022 16:26:50 +0100
Subject: Better project layout, removed warnings

---
 src/Micro/Parser.hs | 223 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 223 insertions(+)
 create mode 100644 src/Micro/Parser.hs

(limited to 'src/Micro/Parser.hs')

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)
-- 
cgit v1.2.3