Update with basic Parser types

5 files changed, 379 insertions, 10 deletions

diff --git a/app/Main.hs b/app/Main.hs
index dc849e7..a81cf7c 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,4 +1,9 @@
 import GSA
 
+import qualified Data.Text.IO as T (readFile)
+import Data.Text (Text)
+
 main :: IO ()
-main = putStrLn "heyyyyyy"
+main = do
+  t <- T.readFile "main.gsa"
+  print $ parse "main.gsa" t
diff --git a/gsa-parser.cabal b/gsa-parser.cabal
index a171840..e0115df 100644
--- a/gsa-parser.cabal
+++ b/gsa-parser.cabal
@@ -35,6 +35,7 @@ library
   exposed-modules: GSA
                  , GSA.Common
                  , GSA.Types
+                 , GSA.Parser
   build-depends:
     , containers
     , mtl
@@ -46,6 +47,7 @@ executable gsa-parser-exe
   hs-source-dirs: app
   main-is:        Main.hs
   build-depends:  gsa-parser
+                , text
   ghc-options:    -threaded -rtsopts -with-rtsopts=-N
 
 test-suite gsa-parser-test
diff --git a/src/GSA.hs b/src/GSA.hs
index 3262c33..cbf1220 100644
--- a/src/GSA.hs
+++ b/src/GSA.hs
@@ -1,7 +1,10 @@
 module GSA
-  ( someFunc,
+  ( module GSA.Parser,
+    module GSA.Types,
+    module GSA.Common
   )
 where
 
-someFunc :: IO ()
-someFunc = putStrLn "hey"
+import GSA.Parser
+import GSA.Types
+import GSA.Common
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
diff --git a/src/GSA/Types.hs b/src/GSA/Types.hs
index a99cac7..ff6bb15 100644
--- a/src/GSA/Types.hs
+++ b/src/GSA/Types.hs
@@ -1,7 +1,9 @@
 module GSA.Types where
 
 import Data.IntMap.Strict (IntMap)
+import Data.Map.Strict (Map)
 import Data.Text (Text)
+import Data.Int (Int64)
 
 data Typ
   = Tint
@@ -38,6 +40,7 @@ data Chunk
   | Mfloat64
   | Many32
   | Many64
+  deriving (Eq, Show)
 
 signatureMain :: Signature
 signatureMain = Signature {sigArgs = [], sigRes = Tret Tint}
@@ -48,11 +51,153 @@ newtype Reg = Reg {getReg :: Int} deriving (Eq, Show)
 
 newtype Ident = Ident {getIdent :: Int} deriving (Eq, Show)
 
-newtype Addressing = Addressing {getAddressing :: Int} deriving (Eq, Show)
+newtype Ptrofs = Ptrofs { getPtrofs :: Int } deriving (Eq, Show)
+
+data Comparison =
+  Ceq
+  | Cne
+  | Clt
+  | Cle
+  | Cgt
+  | Cge
+  deriving (Eq, Show)
+
+negateComparison Ceq = Cne
+negateComparison Cne = Ceq
+negateComparison Clt = Cge
+negateComparison Cle = Cgt
+negateComparison Cgt = Cle
+negateComparison Cge = Clt
+
+swapComparison Ceq = Ceq
+swapComparison Cne = Cne
+swapComparison Clt = Cgt
+swapComparison Cle = Cge
+swapComparison Cgt = Clt
+swapComparison Cge = Cle
+
+data Condition =
+  Ccomp Comparison
+  | Ccompu Comparison
+  | Ccompimm Comparison Int
+  | Ccompuimm Comparison Int
+  | Ccompl Comparison
+  | Ccomplu Comparison
+  | Ccomplimm Comparison Int64
+  | Ccompluimm Comparison Int64
+  | Ccompf Comparison
+  | Cnotcompf Comparison
+  | Ccompfs Comparison
+  | Cnotcompfs Comparison
+  | Cmaskzero Int
+  | Cmasknotzero Int
+  deriving (Eq, Show)
 
-newtype Operation = Operation {getOperation :: Int} deriving (Eq, Show)
+data Addressing =
+  Aindexed Integer
+  | Aindexed2 Integer
+  | Ascaled Integer Integer
+  | Aindexed2scaled Integer Integer
+  | Aglobal Ident Ptrofs
+  | Abased Ident Ptrofs
+  | Abasedscaled Integer Ident Ptrofs
+  | Ainstack Ptrofs
+  deriving (Eq, Show)
 
-type Condition = Int
+data Operation = Omove
+  | Ointconst Int
+  | Olongconst Int64
+  | Ofloatconst Double
+  | Osingleconst Float
+  | Oindirectsymbol Ident
+  | Ocast8signed
+  | Ocast8unsigned
+  | Ocast16signed
+  | Ocast16unsigned
+  | Oneg
+  | Osub
+  | Omul
+  | Omulimm Int
+  | Omulhs
+  | Omulhu
+  | Odiv
+  | Odivu
+  | Omod
+  | Omodu
+  | Oand
+  | Oandimm Int
+  | Oor
+  | Oorimm Int
+  | Oxor
+  | Oxorimm Int
+  | Onot
+  | Oshl
+  | Oshlimm Int
+  | Oshr
+  | Oshrimm Int
+  | Oshrximm Int
+  | Oshru
+  | Oshruimm Int
+  | Ororimm Int
+  | Oshldimm Int
+  | Olea Addressing
+  | Omakelong
+  | Olowlong
+  | Ohighlong
+  | Ocast32signed
+  | Ocast32unsigned
+  | Onegl
+  | Oaddlimm Int64
+  | Osubl
+  | Omull
+  | Omullimm Int64
+  | Omullhs
+  | Omullhu
+  | Odivl
+  | Odivlu
+  | Omodl
+  | Omodlu
+  | Oandl
+  | Oandlimm Int64
+  | Oorl
+  | Oorlimm Int64
+  | Oxorl
+  | Oxorlimm Int64
+  | Onotl
+  | Oshll
+  | Oshllimm Int
+  | Oshrl
+  | Oshrlimm Int
+  | Oshrxlimm Int
+  | Oshrlu
+  | Oshrluimm Int
+  | Ororlimm Int
+  | Oleal Addressing
+  | Onegf
+  | Oabsf
+  | Oaddf
+  | Osubf
+  | Omulf
+  | Odivf
+  | Onegfs
+  | Oabsfs
+  | Oaddfs
+  | Osubfs
+  | Omulfs
+  | Odivfs
+  | Osingleoffloat
+  | Ofloatofsingle
+  | Ointoffloat
+  | Ofloatofint
+  | Ointofsingle
+  | Osingleofint
+  | Olongoffloat
+  | Ofloatoflong
+  | Olongofsingle
+  | Osingleoflong
+  | Ocmp Condition
+  | Osel Condition Typ
+  deriving (Eq, Show)
 
 data Pred a
   = Ptrue
@@ -82,8 +227,6 @@ data Instruction
   | Imfunc [MergeInstruction]
   deriving (Eq, Show)
 
-newtype MergeBlock = MergeBlock {getMergeBlock :: [MergeInstruction]} deriving (Eq, Show)
-
 newtype Code = Code {getCode :: IntMap Instruction} deriving (Eq, Show)
 
 data Function = Function
@@ -96,4 +239,4 @@ data Function = Function
   }
   deriving (Eq, Show)
 
-newtype Program = Program {getProgram :: [Function]} deriving (Eq, Show)
+newtype Program = Program {getProgram :: Map Text Function} deriving (Eq, Show)