InitialHEADmaster

1 files changed, 67 insertions, 0 deletions

diff --git a/Parser.hs b/Parser.hs
new file mode 100644
index 0000000..fda3662
--- /dev/null
+++ b/Parser.hs
@@ -0,0 +1,67 @@
+module Parser where
+
+import Control.Monad (void)
+import Data.Char (isSpace)
+import Data.Functor.Identity (Identity)
+import Text.Parsec
+import Text.Parsec.Expr
+import Debug.Trace
+
+import Expr
+
+
+type Parser = Parsec String ()
+
+pLexemeSuffix :: Parser ()
+pLexemeSuffix = eof <|> lookAhead (void (oneOf "()")) <|> void (many1 space)
+
+lexeme :: String -> Parser ()
+lexeme s = try $ string s >> pLexemeSuffix
+
+operators :: OperatorTable String () Identity Expr
+operators =
+  [[Prefix (symPrefix "+")]
+  ,[Infix (symInfix "*") AssocLeft]
+  ,[Infix (symInfix "+") AssocLeft
+   ,Infix (symInfix "-") AssocLeft]
+  ,[Infix (symInfix ":≤") AssocNone]]
+  where
+    symInfix :: String -> Parser (Expr -> Expr -> Expr)
+    symInfix name = do
+      lexeme name
+      return (einfix name)
+
+    symPrefix :: String -> Parser (Expr -> Expr)
+    symPrefix name = do
+      lexeme name
+      return (EPrefix name)
+
+pAtom :: Parser Expr
+pAtom = do
+  e <- pAtom'
+  traceM ("pAtom: " ++ show e)
+  return e
+
+pAtom' :: Parser Expr
+pAtom' = choice
+  [do _ <- char '('
+      _ <- many space
+      e <- pExpr
+      lexeme ")"
+      return e
+  ,do s <- many1 digit
+      pLexemeSuffix
+      return (ELitInt (read s))
+  ,do s <- many1 (satisfy (\c -> not (isSpace c) && c `notElem` "(){}"))
+      pLexemeSuffix
+      return (EVar s)]
+
+pExpr :: Parser Expr
+pExpr = buildExpressionParser operators pAtom
+
+parseExpr :: Parser Expr
+parseExpr = do
+  _ <- many space
+  e <- pExpr
+  eof
+  return e