parser

Co-Authored-By: AnyUnderstanding <christopher.alan.w@gmail.com>

1 files changed, 90 insertions, 0 deletions

diff --git a/lllars/parser.hs b/lllars/parser.hs
new file mode 100644
index 0000000..88f9951
--- /dev/null
+++ b/lllars/parser.hs
@@ -0,0 +1,90 @@
+import           Data.Functor                   ( ($>) )
+import           Data.Void
+import           Text.Megaparsec         hiding ( Label
+                                                , Pos
+                                                , label
+                                                )
+import           Text.Megaparsec.Char
+import qualified Text.Megaparsec.Char.Lexer    as L
+
+type Parser = Parsec Void String
+type Program = [Instr]
+
+type Address = Int
+type Label = String
+
+data Access = Access Address | SAccess Access
+  deriving Show
+data Operation = ADD | MUL | SUB | DIV | AND | OR | XOR
+  deriving Show
+data Addressation = Address Access | BinaryOperation Access Operation Access
+  deriving Show
+data Call = WriteCall | ReadCall
+  deriving Show
+data BranchPolarity = IfTrue | IfFalse
+  deriving Show
+data Instr = Comment String | Write Address Addressation | LarsCall Call | Label Label | GoTo Label | Branch BranchPolarity Address Label
+  deriving Show
+
+comment :: Parser Instr
+comment =
+  Comment <$> (some (string "lars") *> many (satisfy $ not . (== '\n')))
+
+access :: Parser Access
+access = (SAccess <$> (string "sral" *> access)) <|> (Access <$> L.decimal)
+
+binaryOperation :: Parser Operation
+binaryOperation =
+  (char '+' $> ADD)
+    <|> (char '-' $> SUB)
+    <|> (char '*' $> MUL)
+    <|> (char '/' $> DIV)
+
+addressation :: Parser Addressation
+addressation =
+  try (BinaryOperation <$> access <*> binaryOperation <*> access)
+    <|> (Address <$> access)
+
+-- TODO: arguments
+call :: Parser Instr
+call =
+  LarsCall
+    <$> (  string "larssral"
+        *> ((string "lars" $> ReadCall) <|> (string "sral" $> WriteCall))
+        )
+
+write :: Parser Instr
+write = do
+  target <- L.decimal
+  string "lars"
+  source <- addressation
+  return $ Write target source
+
+label :: Parser Label
+label = char '@' *> (concat <$> some (string "lars" <|> string "sral"))
+
+namedLabel :: Parser Instr
+namedLabel = Label <$> label
+
+goto :: Parser Instr
+goto = GoTo <$> (string "sralllars " *> label)
+
+branch :: Parser Instr
+branch =
+  Branch
+    <$> ((string "lars|sral" $> IfTrue) <|> (string "sral|lars" $> IfFalse))
+    <*> L.decimal
+    <*> label
+
+instr :: Parser Instr
+instr = comment <|> write <|> call <|> namedLabel <|> goto <|> branch
+
+program :: Parser Program
+program = sepEndBy instr (some $ char '\n')
+
+main :: IO ()
+main = do
+  f <- readFile "lars.lars"
+  case runParser (program <* eof) "" f of
+    Right res -> print res
+    Left  err -> putStrLn $ errorBundlePretty err