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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
module AssemblerInterpreter where
import Data.Maybe (fromMaybe)
import Text.Parsec
import Text.Parsec.Char
interpret :: String -> Maybe String
interpret prog = Nothing
type Parser = Parsec String ()
data Op =
Mov | Inc | Dec | Add | Sub | Mul | Div | Jmp | Cmp | Jne | Je |
Jge | Jg | Jle | Jl | Call | Ret | Msg | End
deriving (Show)
argsNum Mov = 2
argsNum Inc = 1
argsNum Dec = 1
argsNum Add = 2
argsNum Sub = 2
argsNum Mul = 2
argsNum Div = 2
argsNum Jmp = 1
argsNum Cmp = 2
argsNum Jne = 1
argsNum Je = 1
argsNum Jge = 1
argsNum Jg = 1
argsNum Jle = 1
argsNum Jl = 1
argsNum Call= 1
argsNum Ret = 0
argsNum Msg = -1
argsNum End = 0
opStrP :: Parser String
opStrP = choice $ map string' [
"mov", "inc", "dec", "add", "sub", "mul", "div", "jmp", "cmp", "jne",
"je", "jge", "jg", "jle", "jl", "call", "ret", "msg", "end"]
opP :: Parser Op
opP = do
s <- opStrP
case s of
"mov" -> return Mov
"inc" -> return Inc
"dec" -> return Dec
"add" -> return Add
"sub" -> return Sub
"mul" -> return Mul
"div" -> return Div
"jmp" -> return Jmp
"cmp" -> return Cmp
"jne" -> return Jne
"je" -> return Je
"jge" -> return Jge
"jg" -> return Jg
"jle" -> return Jle
"jl" -> return Jl
"call"-> return Call
"ret" -> return Ret
"msg" -> return Msg
"end" -> return End
newtype Label = Label String
deriving (Show)
inlineSpace :: Parser Char
inlineSpace = oneOf [' ', '\t']
inlineSpaces = skipMany $ oneOf [' ', '\t']
identifierP :: Parser String
identifierP = do
notFollowedBy opStrP
x <- letter <|> oneOf ['_']
xs <- many (alphaNum <|> oneOf ['_'])
return (x:xs)
labelP :: Parser Label
labelP = do
id <- identifierP
oneOf [':']
return $ Label id
data Stmt = LabelStmt Label | InstrStmt Op [Arg]
deriving (Show)
data Arg = IdentifierArg String | NumberArg Int | StringArg String
deriving (Show)
argP :: Parser Arg
argP = do
inlineSpaces
let identifierArgP = IdentifierArg <$> identifierP
numberP = NumberArg . read <$> many1 digit
stringP = do
oneOf ['\''] :: Parser Char
str <- many $ noneOf ['\'']
oneOf ['\'']
return $ StringArg str
arg <- identifierArgP <|> numberP <|> stringP
inlineSpaces
return arg
stmtP :: Parser Stmt
stmtP = do
let
labelStmtP = LabelStmt <$> labelP
argsP = do
inlineSpaces
oneOf [',']
inlineSpaces
arg <- argP
inlineSpaces
return arg
instrStmtP = do
op <- opP
inlineSpaces
marg <- optionMaybe argP
args <- case marg of
Just arg -> do
targs <- many argsP
return (arg:targs)
Nothing -> return []
return $ InstrStmt op args
inlineSpaces
stmt <- labelStmtP <|> instrStmtP
inlineSpaces
return stmt
commentP :: Parser ()
commentP = do
oneOf [';']
many $ noneOf ['\n']
return ()
stmtLineP :: Parser [Stmt]
stmtLineP = do
inlineSpaces
ms <- optionMaybe stmtP
inlineSpaces
optional commentP
inlineSpaces
case ms of
Just s -> return [s]
Nothing -> return []
progP :: Parser [Stmt]
progP = do
let newlineP = do
newline :: Parser Char
return (++)
stmts <- chainl stmtLineP newlineP []
spaces
return stmts
main = do
print $ runParser opP () "" "msg"
print $ runParser stmtLineP () "" "ret"
print $ runParser progP () "" "ret \n mov a , 12\n uwu: \n ret"
print $ runParser progP () "" "ret ; 123 ; 123\n mov a , 12\n uwu: \n ret"
print $ runParser progP () "" "\nmov a, 2 ; value1\nmov b, 10 ; value2\nmov c, a ; temp1\nmov d, b ; temp2\ncall proc_func\ncall print\nend\n\nproc_func:\n cmp d, 1\n je continue\n mul c, a\n dec d\n call proc_func\n\ncontinue:\n ret\n\nprint:\n msg a, '^', b, ' = ', c\n ret\n"
|
