21 data Identifier = Identifier String |
21 data Identifier = Identifier String |
22 deriving Show |
22 deriving Show |
23 data TypesAndVars = TypesAndVars [TypeVarDeclaration] |
23 data TypesAndVars = TypesAndVars [TypeVarDeclaration] |
24 deriving Show |
24 deriving Show |
25 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl |
25 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl |
26 | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe Expression) |
26 | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression) |
27 | FunctionDeclaration Identifier TypeDecl (Maybe Phrase) |
27 | FunctionDeclaration Identifier TypeDecl (Maybe Phrase) |
28 deriving Show |
28 deriving Show |
29 data TypeDecl = SimpleType Identifier |
29 data TypeDecl = SimpleType Identifier |
30 | RangeType Range |
30 | RangeType Range |
31 | Sequence [Identifier] |
31 | Sequence [Identifier] |
47 data Phrase = ProcCall Identifier [Expression] |
47 data Phrase = ProcCall Identifier [Expression] |
48 | IfThenElse Expression Phrase (Maybe Phrase) |
48 | IfThenElse Expression Phrase (Maybe Phrase) |
49 | WhileCycle Expression Phrase |
49 | WhileCycle Expression Phrase |
50 | RepeatCycle Expression [Phrase] |
50 | RepeatCycle Expression [Phrase] |
51 | ForCycle Identifier Expression Expression Phrase |
51 | ForCycle Identifier Expression Expression Phrase |
52 | WithBlock Expression Phrase |
52 | WithBlock Reference Phrase |
53 | Phrases [Phrase] |
53 | Phrases [Phrase] |
54 | SwitchCase Expression [(Expression, Phrase)] (Maybe Phrase) |
54 | SwitchCase Expression [(Expression, Phrase)] (Maybe Phrase) |
55 | Assignment Reference Expression |
55 | Assignment Reference Expression |
56 deriving Show |
56 deriving Show |
57 data Expression = Expression String |
57 data Expression = Expression String |
69 | FunCall [Expression] Reference |
69 | FunCall [Expression] Reference |
70 | SimpleReference Identifier |
70 | SimpleReference Identifier |
71 | Dereference Reference |
71 | Dereference Reference |
72 | RecordField Reference Reference |
72 | RecordField Reference Reference |
73 | Address Reference |
73 | Address Reference |
|
74 deriving Show |
|
75 data InitExpression = InitBinOp String InitExpression InitExpression |
|
76 | InitPrefixOp String InitExpression |
|
77 | InitReference Identifier |
|
78 | InitArray [InitExpression] |
|
79 | InitRecord [(Identifier, InitExpression)] |
|
80 | InitFloat String |
|
81 | InitNumber String |
|
82 | InitHexNumber String |
|
83 | InitString String |
|
84 | InitChar String |
|
85 | InitNull |
74 deriving Show |
86 deriving Show |
75 |
87 |
76 pascalLanguageDef |
88 pascalLanguageDef |
77 = emptyDef |
89 = emptyDef |
78 { commentStart = "(*" |
90 { commentStart = "(*" |
202 comments |
214 comments |
203 t <- typeDecl |
215 t <- typeDecl |
204 return () |
216 return () |
205 char '=' |
217 char '=' |
206 comments |
218 comments |
207 e <- expression |
219 e <- initExpression |
208 comments |
220 comments |
209 return $ VarDeclaration False ([i], UnknownType) (Just e) |
221 return $ VarDeclaration False ([i], UnknownType) (Just e) |
210 |
222 |
211 typeDecl = choice [ |
223 typeDecl = choice [ |
212 char '^' >> typeDecl >>= return . PointerTo |
224 char '^' >> typeDecl >>= return . PointerTo |
213 , try (string "shortstring") >> return String |
225 , try (string "shortstring") >> return String |
214 , arrayDecl |
226 , arrayDecl |
215 , recordDecl |
227 , recordDecl |
|
228 , sequenceDecl >>= return . Sequence |
|
229 , try (identifier pas) >>= return . SimpleType . Identifier |
216 , rangeDecl >>= return . RangeType |
230 , rangeDecl >>= return . RangeType |
217 , sequenceDecl >>= return . Sequence |
|
218 , identifier pas >>= return . SimpleType . Identifier |
|
219 ] <?> "type declaration" |
231 ] <?> "type declaration" |
220 where |
232 where |
221 arrayDecl = do |
233 arrayDecl = do |
222 try $ string "array" |
234 try $ string "array" |
223 comments |
235 comments |
398 ] |
410 ] |
399 , [ Infix (try $ string "and" >> return (BinOp "and")) AssocLeft |
411 , [ Infix (try $ string "and" >> return (BinOp "and")) AssocLeft |
400 , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft |
412 , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft |
401 , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft |
413 , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft |
402 ] |
414 ] |
403 , [ Infix (try $ string "shl" >> return (BinOp "and")) AssocNone |
415 , [ Infix (try $ string "shl" >> return (BinOp "shl")) AssocNone |
404 , Infix (try $ string "shr" >> return (BinOp "or")) AssocNone |
416 , Infix (try $ string "shr" >> return (BinOp "shr")) AssocNone |
405 ] |
417 ] |
406 , [Prefix (try (string "not") >> return (PrefixOp "not"))] |
418 , [Prefix (try (string "not") >> return (PrefixOp "not"))] |
407 ] |
419 ] |
408 |
420 |
409 phrasesBlock = do |
421 phrasesBlock = do |
541 comments |
553 comments |
542 u <- (iD >>= \i -> comments >> return i) `sepBy1` (char ',' >> comments) |
554 u <- (iD >>= \i -> comments >> return i) `sepBy1` (char ',' >> comments) |
543 char ';' |
555 char ';' |
544 comments |
556 comments |
545 return u |
557 return u |
|
558 |
|
559 initExpression = buildExpressionParser table term <?> "initialization expression" |
|
560 where |
|
561 term = comments >> choice [ |
|
562 try $ parens pas (commaSep pas $ initExpression) >>= return . InitArray |
|
563 , parens pas (semiSep pas $ recField) >>= return . InitRecord |
|
564 , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . InitNumber . show) i |
|
565 , try $ float pas >>= return . InitFloat . show |
|
566 , stringLiteral pas >>= return . InitString |
|
567 , char '#' >> many digit >>= return . InitChar |
|
568 , char '$' >> many hexDigit >>= return . InitHexNumber |
|
569 , try $ string "nil" >> return InitNull |
|
570 , iD >>= return . InitReference |
|
571 ] |
|
572 |
|
573 recField = do |
|
574 i <- iD |
|
575 spaces |
|
576 char ':' |
|
577 spaces |
|
578 e <- initExpression |
|
579 spaces |
|
580 return (i ,e) |
|
581 |
|
582 table = [ |
|
583 [ Infix (char '*' >> return (InitBinOp "*")) AssocLeft |
|
584 , Infix (char '/' >> return (InitBinOp "/")) AssocLeft |
|
585 , Infix (try (string "div") >> return (InitBinOp "div")) AssocLeft |
|
586 , Infix (try (string "mod") >> return (InitBinOp "mod")) AssocLeft |
|
587 ] |
|
588 , [ Infix (char '+' >> return (InitBinOp "+")) AssocLeft |
|
589 , Infix (char '-' >> return (InitBinOp "-")) AssocLeft |
|
590 , Prefix (char '-' >> return (InitPrefixOp "-")) |
|
591 ] |
|
592 , [ Infix (try (string "<>") >> return (InitBinOp "<>")) AssocNone |
|
593 , Infix (try (string "<=") >> return (InitBinOp "<=")) AssocNone |
|
594 , Infix (try (string ">=") >> return (InitBinOp ">=")) AssocNone |
|
595 , Infix (char '<' >> return (InitBinOp "<")) AssocNone |
|
596 , Infix (char '>' >> return (InitBinOp ">")) AssocNone |
|
597 , Infix (char '=' >> return (InitBinOp "=")) AssocNone |
|
598 ] |
|
599 , [ Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft |
|
600 , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft |
|
601 , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft |
|
602 ] |
|
603 , [ Infix (try $ string "shl" >> return (InitBinOp "and")) AssocNone |
|
604 , Infix (try $ string "shr" >> return (InitBinOp "or")) AssocNone |
|
605 ] |
|
606 , [Prefix (try (string "not") >> return (InitPrefixOp "not"))] |
|
607 ] |
|
608 |