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
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
module Language.Elna.AST
( ConstantDefinition(..)
, Expression(..)
, Identifier(..)
, Literal(..)
, ProcedureDeclaration(..)
, Program(..)
, Statement(..)
, VariableDeclaration(..)
, TypeName(..)
) where
import Data.Int (Int32)
import Data.List (intercalate)
import Data.Word (Word8)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Char (chr)
newtype Identifier = Identifier { unIdentifier :: Text }
deriving Eq
instance Show Identifier
where
show (Identifier identifier) = Text.unpack identifier
data TypeName
= NamedType Identifier
| PointerType TypeName
| ArrayType TypeName Int32
| ProcedureType [Parameter]
deriving Eq
instance Show TypeName
where
show (NamedType typeName) = show typeName
show (PointerType typeName) = '^' : show typeName
show (ArrayType typeName elementCount) = concat
[show typeName, "[", show elementCount, "]"]
show (ProcedureType parameters) = "proc" <> showParameters parameters
data Literal
= StringLiteral Text
| IntegerLiteral Int32
| CharacterLiteral Word8
| BooleanLiteral Bool
deriving Eq
instance Show Literal
where
show (StringLiteral string) = Text.unpack
$ "\"" <> string <> "\""
show (IntegerLiteral integer) = show integer
show (CharacterLiteral character) =
'\'' : chr (fromEnum character) : ['\'']
show (BooleanLiteral boolean)
| boolean = "true"
| otherwise = "false"
data Expression
= VariableExpression Identifier
| LiteralExpression Literal
| NegationExpression Expression
| NotExpression Expression
| ReferenceExpression Expression
| DereferenceExpression Expression
| SumExpression Expression Expression
| SubtractionExpression Expression Expression
| ProductExpression Expression Expression
| DivisionExpression Expression Expression
| EqualExpression Expression Expression
| NonEqualExpression Expression Expression
| LessExpression Expression Expression
| GreaterExpression Expression Expression
| LessOrEqualExpression Expression Expression
| GreaterOrEqualExpression Expression Expression
| IfExpression Expression Statement Statement
| LoopExpression Expression Statement
| FieldExpression Expression Identifier
deriving Eq
instance Show Expression
where
show (VariableExpression variable) = show variable
show (LiteralExpression literal) = show literal
show (NegationExpression negation) = '-' : show negation
show (NotExpression negation) = "not " <> show negation
show (ReferenceExpression reference) = '@' : show reference
show (DereferenceExpression dereference) = show dereference <> "^"
show (SumExpression lhs rhs) = concat [show lhs, " + ", show rhs]
show (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs]
show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs]
show (EqualExpression lhs rhs) = concat [show lhs, " = ", show rhs]
show (NonEqualExpression lhs rhs) = concat [show lhs, " /= ", show rhs]
show (LessExpression lhs rhs) = concat [show lhs, " < ", show rhs]
show (GreaterExpression lhs rhs) = concat [show lhs, " > ", show rhs]
show (LessOrEqualExpression lhs rhs) = concat [show lhs, " <= ", show rhs]
show (GreaterOrEqualExpression lhs rhs) = concat [show lhs, " >= ", show rhs]
show (IfExpression condition if' else') = concat
[ "if ", show condition
, " then " <> show if'
, " else " <> show else'
]
show (LoopExpression accumulator iteration) = concat
["loop ", show accumulator, " do ", show iteration]
show (FieldExpression fieldExpression identifier) =
show fieldExpression <> "." <> show identifier
data Statement
= LetStatement Identifier TypeName Expression
| CompoundStatement [Statement]
| CallStatement Identifier [Expression]
| ExpressionStatement Expression
| BreakStatement Expression
| ContinueStatement Expression
deriving Eq
instance Show Statement
where
show (LetStatement identifier typeName definition) = concat
["let ", show identifier, ": ", show typeName, " := ", show definition]
show (CompoundStatement statements) = "begin "
<> intercalate "; " (show <$> statements) <> " end"
show (CallStatement name parameters) = show name <> "("
<> intercalate ", " (show <$> parameters) <> ")"
show (ExpressionStatement expression) = show expression
show (BreakStatement break') = "break " <> show break'
show (ContinueStatement continue') = "continue " <> show continue'
data ConstantDefinition =
ConstantDefinition Identifier TypeName Literal
deriving Eq
instance Show ConstantDefinition
where
show (ConstantDefinition identifier typeName definition) = concat
[show identifier, ": ", show typeName, " := ", show definition, ";"]
data Parameter = Parameter Identifier TypeName
deriving Eq
instance Show Parameter
where
show (Parameter identifier typeName) =
show identifier <> ": " <> show typeName
data ProcedureDeclaration
= ProcedureDeclaration Identifier [Parameter]
| ProcedureDefinition Identifier [Parameter] Bool [ConstantDefinition] Statement
deriving Eq
instance Show ProcedureDeclaration
where
show (ProcedureDeclaration procedureName parameters) =
"proc " <> show procedureName <> showParameters parameters <> "; extern;"
show (ProcedureDefinition procedureName parameters exports constants body)
= "proc " <> show procedureName <> showParameters parameters <> ";"
<> showAttributes exports
<> showConstants constants
<> show body <> ";"
data VariableDeclaration
= VariableDeclaration Identifier TypeName
| VariableDefinition Identifier TypeName (Maybe Literal) Bool
deriving Eq
instance Show VariableDeclaration
where
show (VariableDeclaration identifier typeName)
= show identifier <> ": " <> show typeName <> "; extern;"
show (VariableDefinition identifier typeName initialValue exports)
= show identifier <> ": " <> show typeName
<> maybe "" ((" = " <>) . show) initialValue <> ";"
<> showAttributes exports
data Program = Program [ConstantDefinition] [VariableDeclaration] [ProcedureDeclaration] Statement
deriving Eq
instance Show Program
where
show (Program constants globals procedures body)
= showConstants constants <> showVariables globals
<> unlines (show <$> procedures) <> show body <> "."
showAttributes :: Bool -> String
showAttributes True = " export;"
showAttributes False = ""
showParameters :: [Parameter] -> String
showParameters parameters =
"(" <> intercalate ", " (show <$> parameters) <> ")"
showConstants :: [ConstantDefinition] -> String
showConstants constants
| null constants = ""
| otherwise = " const " <> unwords (show <$> constants) <> "\n"
showVariables :: [VariableDeclaration] -> String
showVariables variables
| null variables = ""
| otherwise = " var " <> unwords (show <$> variables) <> "\n"
|
