7 import Text.Parsec.Token |
7 import Text.Parsec.Token |
8 import Text.Parsec.Language |
8 import Text.Parsec.Language |
9 import Data.Char |
9 import Data.Char |
10 |
10 |
11 builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length"] |
11 builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length"] |
12 |
12 |
13 pascalLanguageDef |
13 pascalLanguageDef |
14 = emptyDef |
14 = emptyDef |
15 { commentStart = "(*" |
15 { commentStart = "(*" |
16 , commentEnd = "*)" |
16 , commentEnd = "*)" |
17 , commentLine = "//" |
17 , commentLine = "//" |
25 , "type", "var", "const", "out", "array", "packed" |
25 , "type", "var", "const", "out", "array", "packed" |
26 , "procedure", "function", "with", "for", "to" |
26 , "procedure", "function", "with", "for", "to" |
27 , "downto", "div", "mod", "record", "set", "nil" |
27 , "downto", "div", "mod", "record", "set", "nil" |
28 , "cdecl", "external", "if", "then", "else" |
28 , "cdecl", "external", "if", "then", "else" |
29 ] -- ++ builtin |
29 ] -- ++ builtin |
30 , reservedOpNames= [] |
30 , reservedOpNames= [] |
31 , caseSensitive = False |
31 , caseSensitive = False |
32 } |
32 } |
33 |
33 |
34 preprocessorSwitch :: Stream s m Char => ParsecT s u m String |
34 preprocessorSwitch :: Stream s m Char => ParsecT s u m String |
35 preprocessorSwitch = do |
35 preprocessorSwitch = do |
36 try $ string "{$" |
36 try $ string "{$" |
37 s <- manyTill (noneOf "\n") $ char '}' |
37 s <- manyTill (noneOf "\n") $ char '}' |
38 return s |
38 return s |
39 |
39 |
40 caseInsensitiveString s = do |
40 caseInsensitiveString s = do |
41 mapM_ (\a -> satisfy (\b -> toUpper a == toUpper b)) s <?> s |
41 mapM_ (\a -> satisfy (\b -> toUpper a == toUpper b)) s <?> s |
42 return s |
42 return s |
43 |
43 |
44 pas = patch $ makeTokenParser pascalLanguageDef |
44 pas = patch $ makeTokenParser pascalLanguageDef |
45 where |
45 where |
46 patch tp = tp {stringLiteral = stringL} |
46 patch tp = tp {stringLiteral = stringL} |
47 |
47 |
48 comment = choice [ |
48 comment = choice [ |
49 char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') |
49 char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') |
50 , (try $ string "(*") >> manyTill anyChar (try $ string "*)") |
50 , (try $ string "(*") >> manyTill anyChar (try $ string "*)") |
51 , (try $ string "//") >> manyTill anyChar (try newline) |
51 , (try $ string "//") >> manyTill anyChar (try newline) |
52 ] |
52 ] |
53 |
53 |
54 comments = do |
54 comments = do |
55 spaces |
55 spaces |
56 skipMany $ do |
56 skipMany $ do |
57 preprocessorSwitch <|> comment |
57 preprocessorSwitch <|> comment |
58 spaces |
58 spaces |