tools/pas2c/PascalBasics.hs
author Wuzzy <Wuzzy2@mail.ru>
Sun, 05 May 2019 15:24:19 +0200
changeset 14884 1f0e8a144bad
parent 10120 b7f632c12784
child 15958 24545642473f
permissions -rw-r--r--
Re-style QHeaderView colors
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
     1
{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
     2
module PascalBasics where
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
     3
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
     4
import Text.Parsec.Combinator
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
     5
import Text.Parsec.Char
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
     6
import Text.Parsec.Prim
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
     7
import Text.Parsec.Token
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
     8
import Text.Parsec.Language
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
     9
import Data.Char
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    10
import Control.Monad
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    11
import Data.Functor.Identity
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    12
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    13
char' :: Char -> Parsec String u ()
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    14
char' = void . char
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    15
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    16
string' :: String -> Parsec String u ()
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    17
string' = void . string
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    18
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    19
builtin :: [String]
10120
b7f632c12784 Pas2C recognizes ansistrings
unc0rr
parents: 10113
diff changeset
    20
builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length", "copy"]
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    21
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    22
pascalLanguageDef :: GenLanguageDef String u Identity
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    23
pascalLanguageDef
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    24
    = emptyDef
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    25
    { commentStart   = "(*"
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    26
    , commentEnd     = "*)"
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    27
    , commentLine    = "//"
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    28
    , nestedComments = False
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    29
    , identStart     = letter <|> oneOf "_"
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    30
    , identLetter    = alphaNum <|> oneOf "_"
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    31
    , opLetter       = letter
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    32
    , reservedNames  = [
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    33
            "begin", "end", "program", "unit", "interface"
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    34
            , "implementation", "and", "or", "xor", "shl"
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    35
            , "shr", "while", "do", "repeat", "until", "case", "of"
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    36
            , "type", "var", "const", "out", "array", "packed"
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    37
            , "procedure", "function", "with", "for", "to"
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    38
            , "downto", "div", "mod", "record", "set", "nil"
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    39
            , "cdecl", "external", "if", "then", "else"
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    40
            ] -- ++ builtin
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    41
    , caseSensitive  = False
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    42
    }
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    43
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    44
preprocessorSwitch :: Stream String Identity Char => Parsec String u String
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    45
preprocessorSwitch = do
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    46
    try $ string' "{$"
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    47
    s <- manyTill (noneOf "\n") $ char '}'
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    48
    return s
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    49
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    50
caseInsensitiveString :: Stream String Identity Char => String -> Parsec String u String
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    51
caseInsensitiveString s = do
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    52
    mapM_ (\a -> satisfy (\b -> toUpper a == toUpper b)) s <?> s
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    53
    return s
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    54
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    55
pas :: GenTokenParser String u Identity
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    56
pas = patch $ makeTokenParser pascalLanguageDef
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    57
    where
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    58
    patch tp = tp {stringLiteral = stringL}
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    59
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    60
comment :: Stream String Identity Char => Parsec String u String
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    61
comment = choice [
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    62
        char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}')
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    63
        , (try $ string "(*") >> manyTill anyChar (try $ string "*)")
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    64
        , (try $ string "//") >> manyTill anyChar (try newline)
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    65
        ]
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    66
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    67
comments :: Parsec String u ()
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    68
comments = do
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    69
    spaces
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    70
    skipMany $ do
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    71
        void $ preprocessorSwitch <|> comment
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    72
        spaces
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    73
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    74
stringL :: Parsec String u String
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    75
stringL = do
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    76
    char' '\''
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    77
    s <- (many $ noneOf "'")
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    78
    char' '\''
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    79
    ss <- many $ do
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    80
        char' '\''
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    81
        s' <- (many $ noneOf "'")
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    82
        char' '\''
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    83
        return $ '\'' : s'
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    84
    comments
4feced261c68 partial merge of the webgl branch
koda
parents: 8020
diff changeset
    85
    return $ concat (s:ss)