tools/PascalBasics.hs
author unc0rr
Sat, 25 Aug 2012 23:00:19 +0400
changeset 7600 31a177d2856c
parent 7315 59b5b19e6604
permissions -rw-r--r--
Disable workaround, as it still makes server crash and hung clients are hidden from players anyway
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)