29 data TypeDecl = SimpleType Identifier |
29 data TypeDecl = SimpleType Identifier |
30 | RangeType Range |
30 | RangeType Range |
31 | Sequence [Identifier] |
31 | Sequence [Identifier] |
32 | ArrayDecl Range TypeDecl |
32 | ArrayDecl Range TypeDecl |
33 | RecordType [TypeVarDeclaration] |
33 | RecordType [TypeVarDeclaration] |
|
34 | PointerTo TypeDecl |
34 | UnknownType |
35 | UnknownType |
35 deriving Show |
36 deriving Show |
36 data Range = Range Identifier |
37 data Range = Range Identifier |
37 | RangeFromTo Expression Expression |
38 | RangeFromTo Expression Expression |
38 deriving Show |
39 deriving Show |
61 | CharCode String |
62 | CharCode String |
62 | NumberLiteral String |
63 | NumberLiteral String |
63 | HexNumber String |
64 | HexNumber String |
64 | Address Reference |
65 | Address Reference |
65 | Reference Reference |
66 | Reference Reference |
|
67 | Null |
66 deriving Show |
68 deriving Show |
67 data Reference = ArrayElement Identifier Expression |
69 data Reference = ArrayElement Identifier Expression |
68 | SimpleReference Identifier |
70 | SimpleReference Identifier |
69 | RecordField Reference Reference |
71 | RecordField Reference Reference |
70 | Dereference Reference |
72 | Dereference Reference |
80 , identLetter = alphaNum <|> oneOf "_." |
82 , identLetter = alphaNum <|> oneOf "_." |
81 , reservedNames = [ |
83 , reservedNames = [ |
82 "begin", "end", "program", "unit", "interface" |
84 "begin", "end", "program", "unit", "interface" |
83 , "implementation", "and", "or", "xor", "shl" |
85 , "implementation", "and", "or", "xor", "shl" |
84 , "shr", "while", "do", "repeat", "until", "case", "of" |
86 , "shr", "while", "do", "repeat", "until", "case", "of" |
85 , "type", "var", "const", "out", "array" |
87 , "type", "var", "const", "out", "array", "packed" |
86 , "procedure", "function", "with", "for", "to" |
88 , "procedure", "function", "with", "for", "to" |
87 , "downto", "div", "mod", "record", "set" |
89 , "downto", "div", "mod", "record", "set", "nil" |
88 ] |
90 ] |
89 , reservedOpNames= [] |
91 , reservedOpNames= [] |
90 , caseSensitive = False |
92 , caseSensitive = False |
91 } |
93 } |
92 |
94 |
150 table = [ |
152 table = [ |
151 [Postfix (char '^' >> return Dereference)] |
153 [Postfix (char '^' >> return Dereference)] |
152 , [Infix (char '.' >> return RecordField) AssocLeft] |
154 , [Infix (char '.' >> return RecordField) AssocLeft] |
153 ] |
155 ] |
154 |
156 |
155 varsDecl1 = varsParser many1 |
157 varsDecl1 = varsParser sepEndBy1 |
156 varsDecl = varsParser many |
158 varsDecl = varsParser sepEndBy |
157 varsParser m endsWithSemi = do |
159 varsParser m endsWithSemi = do |
158 vs <- m (aVarDecl >>= \i -> semi pas >> comments >> return i) |
160 vs <- m (aVarDecl endsWithSemi) (semi pas) |
159 v <- if not endsWithSemi then liftM (\a -> [a]) aVarDecl else return [] |
161 return vs |
160 comments |
162 |
161 return $ vs ++ v |
163 aVarDecl endsWithSemi = do |
162 where |
164 when (not endsWithSemi) $ |
163 aVarDecl = do |
165 optional $ choice [ |
164 when (not endsWithSemi) $ |
166 try $ string "var" |
165 optional $ choice [ |
167 , try $ string "const" |
166 try $ string "var" |
168 , try $ string "out" |
167 , try $ string "const" |
169 ] |
168 , try $ string "out" |
170 comments |
169 ] |
171 ids <- do |
170 comments |
172 i <- (commaSep1 pas) $ (try iD <?> "variable declaration") |
171 ids <- try $ do |
173 char ':' |
172 i <- (commaSep1 pas) $ (iD <?> "variable declaration") |
174 return i |
173 char ':' |
175 comments |
174 return i |
176 t <- typeDecl <?> "variable type declaration" |
175 comments |
177 comments |
176 t <- typeDecl <?> "variable type declaration" |
178 init <- option Nothing $ do |
177 comments |
179 char '=' |
178 init <- option Nothing $ do |
180 comments |
179 char '=' |
181 e <- expression |
180 comments |
182 comments |
181 e <- expression |
183 return (Just e) |
182 comments |
184 return $ VarDeclaration False (ids, t) init |
183 char ';' |
|
184 comments |
|
185 return (Just e) |
|
186 return $ VarDeclaration False (ids, t) init |
|
187 |
185 |
188 |
186 |
189 constsDecl = do |
187 constsDecl = do |
190 vs <- many (try (aConstDecl >>= \i -> semi pas >> return i) >>= \i -> comments >> return i) |
188 vs <- many (try (aConstDecl >>= \i -> semi pas >> return i) >>= \i -> comments >> return i) |
191 comments |
189 comments |
204 e <- expression |
202 e <- expression |
205 comments |
203 comments |
206 return $ VarDeclaration False ([i], UnknownType) (Just e) |
204 return $ VarDeclaration False ([i], UnknownType) (Just e) |
207 |
205 |
208 typeDecl = choice [ |
206 typeDecl = choice [ |
209 arrayDecl |
207 char '^' >> typeDecl >>= return . PointerTo |
|
208 , arrayDecl |
210 , recordDecl |
209 , recordDecl |
211 , rangeDecl >>= return . RangeType |
210 , rangeDecl >>= return . RangeType |
212 , seqenceDecl >>= return . Sequence |
211 , seqenceDecl >>= return . Sequence |
213 , identifier pas >>= return . SimpleType . Identifier |
212 , identifier pas >>= return . SimpleType . Identifier |
214 ] <?> "type declaration" |
213 ] <?> "type declaration" |
367 , integer pas >>= return . NumberLiteral . show |
368 , integer pas >>= return . NumberLiteral . show |
368 , stringLiteral pas >>= return . StringLiteral |
369 , stringLiteral pas >>= return . StringLiteral |
369 , char '#' >> many digit >>= return . CharCode |
370 , char '#' >> many digit >>= return . CharCode |
370 , char '$' >> many hexDigit >>= return . HexNumber |
371 , char '$' >> many hexDigit >>= return . HexNumber |
371 , char '@' >> reference >>= return . Address |
372 , char '@' >> reference >>= return . Address |
|
373 , try $ string "nil" >> return Null |
372 , try $ funCall |
374 , try $ funCall |
373 , reference >>= return . Reference |
375 , reference >>= return . Reference |
374 ] <?> "simple expression" |
376 ] <?> "simple expression" |
375 |
377 |
376 table = [ |
378 table = [ |
377 [Prefix (string "not" >> return (PrefixOp "not"))] |
379 [ Infix (char '*' >> return (BinOp "*")) AssocLeft |
378 , [ Infix (char '*' >> return (BinOp "*")) AssocLeft |
|
379 , Infix (char '/' >> return (BinOp "/")) AssocLeft |
380 , Infix (char '/' >> return (BinOp "/")) AssocLeft |
380 , Infix (try (string "div") >> return (BinOp "div")) AssocLeft |
381 , Infix (try (string "div") >> return (BinOp "div")) AssocLeft |
381 , Infix (try (string "mod") >> return (BinOp "mod")) AssocLeft |
382 , Infix (try (string "mod") >> return (BinOp "mod")) AssocLeft |
382 ] |
383 ] |
383 , [ Infix (char '+' >> return (BinOp "+")) AssocLeft |
384 , [ Infix (char '+' >> return (BinOp "+")) AssocLeft |
393 ] |
394 ] |
394 , [ Infix (try $ string "and" >> return (BinOp "and")) AssocLeft |
395 , [ Infix (try $ string "and" >> return (BinOp "and")) AssocLeft |
395 , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft |
396 , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft |
396 , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft |
397 , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft |
397 ] |
398 ] |
|
399 , [Prefix (try (string "not") >> return (PrefixOp "not"))] |
398 ] |
400 ] |
399 |
401 |
400 phrasesBlock = do |
402 phrasesBlock = do |
401 try $ string "begin" |
403 try $ string "begin" |
402 comments |
404 comments |