1 files changed, 216 insertions, 0 deletions
diff --git a/src/GSA/Parser.hs b/src/GSA/Parser.hs
new file mode 100644
index 0000000..9b25321
--- /dev/null
+++ b/src/GSA/Parser.hs
@@ -0,0 +1,216 @@
+module GSA.Parser where
+
+import Data.Char
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IMap
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Void (Void)
+import GSA.Types
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import qualified Text.Megaparsec.Char.Lexer as L
+
+type Parser = Parsec Void Text
+
+sc :: Parser ()
+sc =
+  L.space
+    space1
+    (L.skipLineComment "//")
+    (L.skipBlockComment "/*" "*/")
+
+lexeme :: Parser a -> Parser a
+lexeme = L.lexeme sc
+
+symbol :: Text -> Parser Text
+symbol = L.symbol sc
+
+parens :: Parser a -> Parser a
+parens = between (symbol "(") (symbol ")")
+
+braces :: Parser a -> Parser a
+braces = between (symbol "{") (symbol "}")
+
+brackets :: Parser a -> Parser a
+brackets = between (symbol "[") (symbol "]")
+
+integer :: Parser Integer
+integer = lexeme L.decimal
+
+float :: Parser Double
+float = lexeme L.float
+
+signedInteger :: Parser Integer
+signedInteger = L.signed sc integer
+
+signedFloat :: Parser Double
+signedFloat = L.signed sc float
+
+charLiteral :: Parser Char
+charLiteral = between (char '\'') (char '\'') L.charLiteral
+
+stringLiteral :: Parser String
+stringLiteral = char '\"' *> manyTill L.charLiteral (char '\"')
+
+typParser :: Parser Typ
+typParser = undefined
+
+retTypParser :: Parser RetTyp
+retTypParser = undefined
+
+chunkParser :: Parser Chunk
+chunkParser = undefined
+
+signatureParser :: Parser Signature
+signatureParser = undefined
+
+nodeParser :: Parser Node
+nodeParser = undefined
+
+regParser :: Parser Reg
+regParser = do
+  char 'x'
+  Reg . fromInteger <$> integer
+
+identParser :: Parser Ident
+identParser = undefined
+
+ptrofsParser :: Parser Ptrofs
+ptrofsParser = undefined
+
+comparisonParser :: Parser Comparison
+comparisonParser =
+  choice
+    [ string "==" >> return Ceq,
+      string "!=" >> return Cne,
+      string "<" >> return Clt,
+      string "<=" >> return Cle,
+      string ">" >> return Cgt,
+      string ">=" >> return Cge
+    ]
+
+compParser :: (Comparison -> Condition) -> Text -> Parser (Condition, [Reg])
+compParser f t = do
+  r1 <- regParser
+  comp <- comparisonParser >> symbol t
+  r2 <- regParser
+  return $ (f comp, [r1, r2])
+
+conditionParser :: Parser (Condition, [Reg])
+conditionParser =
+  choice [ compParser Ccomp "s",
+           compParser Ccompu "u",
+           compParser Ccompl "ls",
+           compParser Ccomplu "lu"
+         ]
+
+addressingParser :: Parser Addressing
+addressingParser = undefined
+
+omoveParser :: Parser (Operation, [Reg])
+omoveParser = do
+  r <- regParser
+  return (Omove, [r])
+
+ointconstParser :: Parser (Operation, [Reg])
+ointconstParser = do
+  i <- fromInteger <$> integer
+  return (Ointconst i, [])
+
+onegParser :: Parser (Operation, [Reg])
+onegParser = do
+  r <- parens (symbol "-" >> regParser)
+  return (Oneg, [r])
+
+obinopParser :: Operation -> Text -> Parser (Operation, [Reg])
+obinopParser op t = do
+  r1 <- regParser
+  r2 <- symbol t >> regParser
+  return (op, [r1, r2])
+
+obinopimmParser :: (Int -> Operation) -> Text -> Parser (Operation, [Reg])
+obinopimmParser op t = do
+  r1 <- regParser
+  i <- symbol t >> fromInteger <$> integer
+  return (op i, [r1])
+
+operationParser :: Parser (Operation, [Reg])
+operationParser =
+  choice
+    [ omoveParser,
+      ointconstParser,
+      onegParser,
+      obinopParser Osub "-",
+      obinopParser Omul "*",
+      obinopimmParser Omulimm "*",
+      obinopParser Odiv "/s",
+      obinopParser Odivu "/u",
+      obinopParser Omod "%s",
+      obinopParser Omodu "%u",
+      obinopParser Oand "&",
+      obinopimmParser Oandimm "&",
+      obinopParser Oor "|",
+      obinopimmParser Oorimm "|"
+    ]
+
+predicateParser :: Parser Predicate
+predicateParser = undefined
+
+mergeinstructionParser :: Parser Instruction
+mergeinstructionParser = undefined
+
+inopParser :: Int -> Parser Instruction
+inopParser i = symbol "nop" >> return (Inop . Node $ i -1)
+
+gotoParser' :: Parser Node
+gotoParser' = symbol "goto" >> integer >>= (return . Node . fromInteger)
+
+gotoParser :: Parser Instruction
+gotoParser = Inop <$> gotoParser'
+
+icondParser :: Parser Instruction
+icondParser = do
+  (cond, args) <- symbol "if" >> parens conditionParser
+  n1 <- gotoParser'
+  n2 <- symbol "else" >> gotoParser'
+  return $ Icond cond args n1 n2
+
+iopParser :: Int -> Parser Instruction
+iopParser i = do
+  r <- regParser
+  symbol "="
+  (op, args) <- operationParser
+  goto <- optional gotoParser'
+  case goto of
+    Just goto' -> return $ Iop op args r goto'
+    Nothing -> return $ Iop op args r (Node $ i -1)
+
+instructionParser :: Parser (Int, Instruction)
+instructionParser = do
+  i <- fromInteger <$> integer
+  symbol ":"
+  instr <- choice [gotoParser, inopParser i, icondParser, iopParser i]
+  return (i, instr)
+
+codeParser :: Parser Code
+codeParser =
+  Code . IMap.fromList <$> many instructionParser
+
+functionParser :: Parser (Text, Function)
+functionParser = do
+  name <- lexeme (takeWhile1P (Just "Function name") isAlphaNum)
+  args <- parens $ regParser `sepBy` symbol ","
+  code <- braces codeParser
+  return (name, Function signatureMain args 0 code (Node 0) [])
+
+gsaParser :: Parser Program
+gsaParser = Program . Map.fromList <$> many functionParser
+
+parse :: String -> Text -> Either String Program
+parse file t =
+  case runParser gsaParser file t of
+    Left a -> Left (show a)
+    Right a -> Right a