tools/PascalBasics.hs
author unc0rr
Sun, 02 Dec 2012 01:25:11 +0400
changeset 8178 8bd087478b48
parent 7315 59b5b19e6604
permissions -rw-r--r--
Fix QSettings problems: - Reopen file in ReadOnly mode if it was open in ReadWrite mode and is being read. This is needed for stupid QSettings which opens file in ReadWrite mode just to call readAll() on it. - Implement setSize(0)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     1
{-# LANGUAGE FlexibleContexts #-}
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     2
module PascalBasics where
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     3
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     4
import Text.Parsec.Combinator
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     5
import Text.Parsec.Char
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     6
import Text.Parsec.Prim
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     7
import Text.Parsec.Token
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     8
import Text.Parsec.Language
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     9
import Data.Char
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    10
7062
7efe16575779 Recognize length on arrays as a separate function
unc0rr
parents: 7042
diff changeset
    11
builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length"]
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7062
diff changeset
    12
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    13
pascalLanguageDef
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    14
    = emptyDef
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    15
    { commentStart   = "(*"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    16
    , commentEnd     = "*)"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    17
    , commentLine    = "//"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    18
    , nestedComments = False
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    19
    , identStart     = letter <|> oneOf "_"
6552
91adc9ee7b8c Disallow dot as a part of identifier
unc0rr
parents: 6520
diff changeset
    20
    , identLetter    = alphaNum <|> oneOf "_"
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    21
    , reservedNames  = [
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    22
            "begin", "end", "program", "unit", "interface"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    23
            , "implementation", "and", "or", "xor", "shl"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    24
            , "shr", "while", "do", "repeat", "until", "case", "of"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    25
            , "type", "var", "const", "out", "array", "packed"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    26
            , "procedure", "function", "with", "for", "to"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    27
            , "downto", "div", "mod", "record", "set", "nil"
6516
addaeb1b9539 Further progress on dealing with namespaces
unc0rr
parents: 6453
diff changeset
    28
            , "cdecl", "external", "if", "then", "else"
6520
6fecdc5d182f Some more work on scopes
unc0rr
parents: 6516
diff changeset
    29
            ] -- ++ builtin
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7062
diff changeset
    30
    , reservedOpNames= []
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7062
diff changeset
    31
    , caseSensitive  = False
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    32
    }
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    33
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    34
preprocessorSwitch :: Stream s m Char => ParsecT s u m String
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    35
preprocessorSwitch = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    36
    try $ string "{$"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    37
    s <- manyTill (noneOf "\n") $ char '}'
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    38
    return s
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7062
diff changeset
    39
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    40
caseInsensitiveString s = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    41
    mapM_ (\a -> satisfy (\b -> toUpper a == toUpper b)) s <?> s
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    42
    return s
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7062
diff changeset
    43
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    44
pas = patch $ makeTokenParser pascalLanguageDef
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    45
    where
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    46
    patch tp = tp {stringLiteral = stringL}
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    47
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    48
comment = choice [
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    49
        char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}')
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    50
        , (try $ string "(*") >> manyTill anyChar (try $ string "*)")
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    51
        , (try $ string "//") >> manyTill anyChar (try newline)
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    52
        ]
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7062
diff changeset
    53
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    54
comments = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    55
    spaces
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    56
    skipMany $ do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    57
        preprocessorSwitch <|> comment
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    58
        spaces
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    59
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    60
stringL = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    61
    (char '\'')
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    62
    s <- (many $ noneOf "'")
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    63
    (char '\'')
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    64
    ss <- many $ do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    65
        (char '\'')
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    66
        s' <- (many $ noneOf "'")
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    67
        (char '\'')
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    68
        return $ '\'' : s'
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7062
diff changeset
    69
    comments
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    70
    return $ concat (s:ss)