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
203
204
205
206
|
module Language.Elna.Frontend.AST
( Declaration(..)
, Identifier(..)
, Parameter(..)
, Program(..)
, Statement(..)
, TypeExpression(..)
, VariableDeclaration(..)
--, VariableAccess(..)
, Condition(..)
, Expression(..)
, Literal(..)
) where
import Data.Char (chr)
import Data.Int (Int32)
import Data.List (intercalate)
import Data.Word (Word8)
import Language.Elna.Location (Identifier(..), showArrayType)
import Numeric (showHex)
import Data.Bifunctor (Bifunctor(bimap))
newtype Program = Program [Declaration]
deriving Eq
instance Show Program
where
show (Program declarations) = unlines (show <$> declarations)
data Declaration
= ProcedureDeclaration Identifier [Parameter] [VariableDeclaration] [Statement]
| TypeDefinition Identifier TypeExpression
deriving Eq
instance Show Declaration
where
show (TypeDefinition identifier typeExpression) =
concat ["type ", show identifier, " = ", show typeExpression, ";"]
show (ProcedureDeclaration procedureName parameters variables body)
= "proc " <> show procedureName <> showParameters parameters <> " {\n"
<> unlines ((" " <>) . show <$> variables)
<> unlines ((" " <>) . show <$> body)
<> "}"
data Parameter = Parameter Identifier TypeExpression Bool
deriving Eq
instance Show Parameter
where
show (Parameter identifier typeName ref) = concat
[ if ref then "ref " else ""
, show identifier, ": ", show typeName
]
showParameters :: [Parameter] -> String
showParameters parameters =
"(" <> intercalate ", " (show <$> parameters) <> ")"
data TypeExpression
= NamedType Identifier
| ArrayType Literal TypeExpression
deriving Eq
instance Show TypeExpression
where
show (NamedType typeName) = show typeName
show (ArrayType elementCount typeName) =
showArrayType elementCount typeName
data Statement
= EmptyStatement
| IfStatement Condition Statement (Maybe Statement)
{-| AssignmentStatement VariableAccess Expression
| WhileStatement Condition Statement -}
| CompoundStatement [Statement]
| CallStatement Identifier [Expression]
deriving Eq
instance Show Statement
where
show EmptyStatement = ";"
show (IfStatement condition if' else') = concat
[ "if (", show condition, ") "
, show if'
, maybe "" ((<> " else ") . show) else'
]
{-show (AssignmentStatement lhs rhs) =
concat [show lhs, " := ", show rhs, ";"]
show (WhileStatement expression statement) =
concat ["while (", show expression, ") ", show statement, ";"]-}
show (CompoundStatement statements) =
concat ["{\n", unlines (show <$> statements), " }"]
show (CallStatement name parameters) = show name <> "("
<> intercalate ", " (show <$> parameters) <> ")"
data VariableDeclaration =
VariableDeclaration Identifier TypeExpression
deriving Eq
data Literal
= DecimalLiteral Int32
| HexadecimalLiteral Int32
| CharacterLiteral Word8
deriving Eq
instance Show Literal
where
show (DecimalLiteral integer) = show integer
show (HexadecimalLiteral integer) = '0' : 'x' : showHex integer ""
show (CharacterLiteral character) =
'\'' : chr (fromEnum character) : ['\'']
instance Ord Literal
where
compare x y = compare (int32Literal x) (int32Literal y)
instance Num Literal
where
x + y = DecimalLiteral $ int32Literal x + int32Literal y
x * y = DecimalLiteral $ int32Literal x * int32Literal y
abs (DecimalLiteral x) = DecimalLiteral $ abs x
abs (HexadecimalLiteral x) = HexadecimalLiteral $ abs x
abs (CharacterLiteral x) = CharacterLiteral $ abs x
negate (DecimalLiteral x) = DecimalLiteral $ negate x
negate (HexadecimalLiteral x) = HexadecimalLiteral $ negate x
negate (CharacterLiteral x) = CharacterLiteral $ negate x
signum (DecimalLiteral x) = DecimalLiteral $ signum x
signum (HexadecimalLiteral x) = HexadecimalLiteral $ signum x
signum (CharacterLiteral x) = CharacterLiteral $ signum x
fromInteger = DecimalLiteral . fromInteger
instance Real Literal
where
toRational (DecimalLiteral integer) = toRational integer
toRational (HexadecimalLiteral integer) = toRational integer
toRational (CharacterLiteral integer) = toRational integer
instance Enum Literal
where
toEnum = DecimalLiteral . fromIntegral
fromEnum = fromEnum . int32Literal
instance Integral Literal
where
toInteger = toInteger . int32Literal
quotRem x y = bimap DecimalLiteral DecimalLiteral
$ quotRem (int32Literal x) (int32Literal y)
int32Literal :: Literal -> Int32
int32Literal (DecimalLiteral integer) = integer
int32Literal (HexadecimalLiteral integer) = integer
int32Literal (CharacterLiteral integer) = fromIntegral integer
instance Show VariableDeclaration
where
show (VariableDeclaration identifier typeExpression) =
concat ["var ", show identifier, ": " <> show typeExpression, ";"]
data Expression
= LiteralExpression Literal
| SumExpression Expression Expression
| SubtractionExpression Expression Expression
| NegationExpression Expression
| ProductExpression Expression Expression
| DivisionExpression Expression Expression
-- | VariableExpression VariableAccess
deriving Eq
instance Show Expression
where
show (LiteralExpression literal) = show literal
show (SumExpression lhs rhs) = concat [show lhs, " + ", show rhs]
show (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs]
show (NegationExpression negation) = '-' : show negation
show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs]
-- show (VariableExpression variable) = show variable
{-
data VariableAccess
= VariableAccess Identifier
| ArrayAccess VariableAccess Expression
deriving Eq
instance Show VariableAccess
where
show (VariableAccess variableName) = show variableName
show (ArrayAccess arrayAccess elementIndex) =
concat [show arrayAccess, "[", show elementIndex, "]"]
-}
data Condition
= EqualCondition Expression Expression
| NonEqualCondition Expression Expression
| LessCondition Expression Expression
| GreaterCondition Expression Expression
| LessOrEqualCondition Expression Expression
| GreaterOrEqualCondition Expression Expression
deriving Eq
instance Show Condition
where
show (EqualCondition lhs rhs) = concat [show lhs, " = ", show rhs]
show (NonEqualCondition lhs rhs) = concat [show lhs, " # ", show rhs]
show (LessCondition lhs rhs) = concat [show lhs, " < ", show rhs]
show (GreaterCondition lhs rhs) = concat [show lhs, " > ", show rhs]
show (LessOrEqualCondition lhs rhs) = concat [show lhs, " <= ", show rhs]
show (GreaterOrEqualCondition lhs rhs) = concat [show lhs, " >= ", show rhs]
|
