author | Wuzzy <almikes@aol.com> |
Wed, 26 Apr 2017 02:28:13 +0200 | |
changeset 12339 | 0bc8c5fcd08c |
parent 10120 | b7f632c12784 |
permissions | -rw-r--r-- |
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 | 2 |
module PascalBasics where |
3 |
||
4 |
import Text.Parsec.Combinator |
|
5 |
import Text.Parsec.Char |
|
6 |
import Text.Parsec.Prim |
|
7 |
import Text.Parsec.Token |
|
8 |
import Text.Parsec.Language |
|
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 | 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 | 20 |
builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length", "copy"] |
10015 | 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 | 23 |
pascalLanguageDef |
24 |
= emptyDef |
|
25 |
{ commentStart = "(*" |
|
26 |
, commentEnd = "*)" |
|
27 |
, commentLine = "//" |
|
28 |
, nestedComments = False |
|
29 |
, identStart = letter <|> oneOf "_" |
|
30 |
, identLetter = alphaNum <|> oneOf "_" |
|
31 |
, opLetter = letter |
|
32 |
, reservedNames = [ |
|
33 |
"begin", "end", "program", "unit", "interface" |
|
34 |
, "implementation", "and", "or", "xor", "shl" |
|
35 |
, "shr", "while", "do", "repeat", "until", "case", "of" |
|
36 |
, "type", "var", "const", "out", "array", "packed" |
|
37 |
, "procedure", "function", "with", "for", "to" |
|
38 |
, "downto", "div", "mod", "record", "set", "nil" |
|
39 |
, "cdecl", "external", "if", "then", "else" |
|
40 |
] -- ++ builtin |
|
41 |
, caseSensitive = False |
|
42 |
} |
|
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 | 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 | 47 |
s <- manyTill (noneOf "\n") $ char '}' |
48 |
return s |
|
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 | 51 |
caseInsensitiveString s = do |
52 |
mapM_ (\a -> satisfy (\b -> toUpper a == toUpper b)) s <?> s |
|
53 |
return s |
|
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 | 56 |
pas = patch $ makeTokenParser pascalLanguageDef |
57 |
where |
|
58 |
patch tp = tp {stringLiteral = stringL} |
|
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 | 61 |
comment = choice [ |
62 |
char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') |
|
63 |
, (try $ string "(*") >> manyTill anyChar (try $ string "*)") |
|
64 |
, (try $ string "//") >> manyTill anyChar (try newline) |
|
65 |
] |
|
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 | 68 |
comments = do |
69 |
spaces |
|
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 | 72 |
spaces |
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 | 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 | 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 | 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 | 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 | 83 |
return $ '\'' : s' |
84 |
comments |
|
85 |
return $ concat (s:ss) |