blob: 03bbf02e4d8dba384c22f0e6d024f887bd479d05 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
import Data.Functor ( ($>) )
import Data.List ( intercalate )
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
data Operation = ADD | MUL | SUB | DIV | AND | OR | XOR
deriving Show
data Addressation = Address Access | BinaryOperation Access Operation Access
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
instance Show Access where
show (Access address) = "{ \"address\": " <> show address <> " }"
show (SAccess access ) = "{ \"sAddress\": " <> show access <> " }"
instance Show Addressation where
show (Address access) = "{ \"access\": " <> show access <> " }"
show (BinaryOperation a op b) =
"{ \"binaryOperation\": { \"a\": "
<> show a
<> ", \"op\": \""
<> show op
<> "\", \"b\": "
<> show b
<> " }}"
instance Show Instr where
show (Comment string) = "{ \"comment\": \"" <> string <> "\" }"
show (Write target source) =
"{ \"write\": { \"target\": "
<> show target
<> ", \"source\": "
<> show source
<> " }}"
show (LarsCall call ) = "{ \"call\": " <> show call <> " }"
show (Label label) = "{ \"label\": " <> show label <> " }"
show (GoTo label) = "{ \"goto\": " <> show label <> " }"
show (Branch pol jmp label) =
"{ \"branch\": { \"polarity\": "
<> show pol
<> ", \"jmp\": "
<> show jmp
<> ", \"label\": "
<> show label
<> "}}"
comment :: Parser Instr
comment = Comment <$> (some (string "lars") *> many (satisfy (/= '\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.lll"
case runParser (program <* eof) "" f of
Right res -> putStrLn $ "[" <> intercalate "," (show <$> res) <> "]"
Left err -> putStrLn $ errorBundlePretty err
|
