8 import Text.Parsec.Prim |
8 import Text.Parsec.Prim |
9 import Text.Parsec.Combinator |
9 import Text.Parsec.Combinator |
10 import Text.Parsec.String |
10 import Text.Parsec.String |
11 import Control.Monad |
11 import Control.Monad |
12 import Data.Maybe |
12 import Data.Maybe |
|
13 import Data.Char |
13 |
14 |
14 import PascalBasics |
15 import PascalBasics |
15 import PascalUnitSyntaxTree |
16 import PascalUnitSyntaxTree |
16 |
17 |
17 knownTypes = ["shortstring", "ansistring", "char", "byte"] |
18 knownTypes = ["shortstring", "ansistring", "char", "byte"] |
353 , try (parens pas $ expression >>= \e -> notFollowedBy (comments >> char '.') >> return e) |
354 , try (parens pas $ expression >>= \e -> notFollowedBy (comments >> char '.') >> return e) |
354 , brackets pas (commaSep pas iD) >>= return . SetExpression |
355 , brackets pas (commaSep pas iD) >>= return . SetExpression |
355 , try $ natural pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i |
356 , try $ natural pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i |
356 , float pas >>= return . FloatLiteral . show |
357 , float pas >>= return . FloatLiteral . show |
357 , natural pas >>= return . NumberLiteral . show |
358 , natural pas >>= return . NumberLiteral . show |
358 , stringLiteral pas >>= return . StringLiteral |
359 , try (string "_S" >> stringLiteral pas) >>= return . StringLiteral |
|
360 , try (string "_P" >> stringLiteral pas) >>= return . PCharLiteral |
|
361 , stringLiteral pas >>= return . strOrChar |
359 , try (string "#$") >> many hexDigit >>= \c -> comments >> return (HexCharCode c) |
362 , try (string "#$") >> many hexDigit >>= \c -> comments >> return (HexCharCode c) |
360 , char '#' >> many digit >>= \c -> comments >> return (CharCode c) |
363 , char '#' >> many digit >>= \c -> comments >> return (CharCode c) |
361 , char '$' >> many hexDigit >>= \h -> comments >> return (HexNumber h) |
364 , char '$' >> many hexDigit >>= \h -> comments >> return (HexNumber h) |
362 , char '-' >> expression >>= return . PrefixOp "-" |
365 , char '-' >> expression >>= return . PrefixOp "-" |
363 , try $ string "nil" >> return Null |
366 , try $ string "nil" >> return Null |
378 , [ Infix (try (string "<>") >> return (BinOp "<>")) AssocNone |
381 , [ Infix (try (string "<>") >> return (BinOp "<>")) AssocNone |
379 , Infix (try (string "<=") >> return (BinOp "<=")) AssocNone |
382 , Infix (try (string "<=") >> return (BinOp "<=")) AssocNone |
380 , Infix (try (string ">=") >> return (BinOp ">=")) AssocNone |
383 , Infix (try (string ">=") >> return (BinOp ">=")) AssocNone |
381 , Infix (char '<' >> return (BinOp "<")) AssocNone |
384 , Infix (char '<' >> return (BinOp "<")) AssocNone |
382 , Infix (char '>' >> return (BinOp ">")) AssocNone |
385 , Infix (char '>' >> return (BinOp ">")) AssocNone |
383 , Infix (char '=' >> return (BinOp "=")) AssocNone |
386 ] |
|
387 , [ Infix (try $ string "shl" >> return (BinOp "shl")) AssocNone |
|
388 , Infix (try $ string "shr" >> return (BinOp "shr")) AssocNone |
384 ] |
389 ] |
385 , [ Infix (try $ string "and" >> return (BinOp "and")) AssocLeft |
390 , [ Infix (try $ string "and" >> return (BinOp "and")) AssocLeft |
386 , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft |
391 , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft |
387 , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft |
392 , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft |
388 ] |
393 ] |
389 , [ Infix (try $ string "shl" >> return (BinOp "shl")) AssocNone |
394 , [ |
390 , Infix (try $ string "shr" >> return (BinOp "shr")) AssocNone |
395 Infix (char '=' >> return (BinOp "=")) AssocNone |
391 ] |
396 ] |
392 ] |
397 ] |
|
398 strOrChar [a] = CharCode . show . ord $ a |
|
399 strOrChar a = StringLiteral a |
393 |
400 |
394 phrasesBlock = do |
401 phrasesBlock = do |
395 try $ string "begin" |
402 try $ string "begin" |
396 comments |
403 comments |
397 p <- manyTill phrase (try $ string "end" >> notFollowedBy alphaNum) |
404 p <- manyTill phrase (try $ string "end" >> notFollowedBy alphaNum) |
561 e <- initExpression |
568 e <- initExpression |
562 spaces |
569 spaces |
563 return (i ,e) |
570 return (i ,e) |
564 |
571 |
565 table = [ |
572 table = [ |
566 [ Infix (char '*' >> return (InitBinOp "*")) AssocLeft |
573 [ |
|
574 Prefix (char '-' >> return (InitPrefixOp "-")) |
|
575 ] |
|
576 , [ Infix (char '*' >> return (InitBinOp "*")) AssocLeft |
567 , Infix (char '/' >> return (InitBinOp "/")) AssocLeft |
577 , Infix (char '/' >> return (InitBinOp "/")) AssocLeft |
568 , Infix (try (string "div") >> return (InitBinOp "div")) AssocLeft |
578 , Infix (try (string "div") >> return (InitBinOp "div")) AssocLeft |
569 , Infix (try (string "mod") >> return (InitBinOp "mod")) AssocLeft |
579 , Infix (try (string "mod") >> return (InitBinOp "mod")) AssocLeft |
570 ] |
580 ] |
571 , [ Infix (char '+' >> return (InitBinOp "+")) AssocLeft |
581 , [ Infix (char '+' >> return (InitBinOp "+")) AssocLeft |
572 , Infix (char '-' >> return (InitBinOp "-")) AssocLeft |
582 , Infix (char '-' >> return (InitBinOp "-")) AssocLeft |
573 , Prefix (char '-' >> return (InitPrefixOp "-")) |
|
574 ] |
583 ] |
575 , [ Infix (try (string "<>") >> return (InitBinOp "<>")) AssocNone |
584 , [ Infix (try (string "<>") >> return (InitBinOp "<>")) AssocNone |
576 , Infix (try (string "<=") >> return (InitBinOp "<=")) AssocNone |
585 , Infix (try (string "<=") >> return (InitBinOp "<=")) AssocNone |
577 , Infix (try (string ">=") >> return (InitBinOp ">=")) AssocNone |
586 , Infix (try (string ">=") >> return (InitBinOp ">=")) AssocNone |
578 , Infix (char '<' >> return (InitBinOp "<")) AssocNone |
587 , Infix (char '<' >> return (InitBinOp "<")) AssocNone |