|
1 module PascalParser where |
|
2 |
|
3 import Text.ParserCombinators.Parsec |
|
4 import Control.Monad |
|
5 |
|
6 data PascalUnit = |
|
7 Program Identificator Implementation FunctionBody |
|
8 | Unit Identificator Interface Implementation (Maybe Initialize) (Maybe Finalize) |
|
9 deriving Show |
|
10 |
|
11 data Interface = Interface Uses TypesAndVars |
|
12 deriving Show |
|
13 data Implementation = Implementation Uses TypesAndVars Functions |
|
14 deriving Show |
|
15 data Functions = Functions [Function] |
|
16 deriving Show |
|
17 data Function = Function String |
|
18 deriving Show |
|
19 data Identificator = Identificator String |
|
20 deriving Show |
|
21 data FunctionBody = FunctionBody String |
|
22 deriving Show |
|
23 data TypesAndVars = TypesAndVars String |
|
24 deriving Show |
|
25 data Initialize = Initialize Functions |
|
26 deriving Show |
|
27 data Finalize = Finalize Functions |
|
28 deriving Show |
|
29 data Uses = Uses [Identificator] |
|
30 deriving Show |
|
31 |
|
32 parsePascalUnit :: String -> Either ParseError PascalUnit |
|
33 parsePascalUnit = parse pascalUnit "unit" |
|
34 where |
|
35 comments = skipMany (comment >> spaces) |
|
36 identificator = do |
|
37 spaces |
|
38 l <- letter <|> oneOf "_" |
|
39 ls <- many (alphaNum <|> oneOf "_") |
|
40 spaces |
|
41 return $ Identificator (l:ls) |
|
42 |
|
43 pascalUnit = do |
|
44 spaces |
|
45 comments |
|
46 u <- choice [program, unit] |
|
47 comments |
|
48 spaces |
|
49 return u |
|
50 |
|
51 comment = choice [ |
|
52 char '{' >> manyTill anyChar (try $ char '}') |
|
53 , string "(*" >> manyTill anyChar (try $ string "*)") |
|
54 , string "//" >> manyTill anyChar (try newline) |
|
55 ] |
|
56 |
|
57 unit = do |
|
58 name <- unitName |
|
59 spaces |
|
60 comments |
|
61 int <- string "interface" >> interface |
|
62 manyTill anyChar (try $ string "implementation") |
|
63 spaces |
|
64 comments |
|
65 impl <- implementation |
|
66 return $ Unit name int impl Nothing Nothing |
|
67 where |
|
68 unitName = between (string "unit") (char ';') identificator |
|
69 |
|
70 interface = do |
|
71 spaces |
|
72 comments |
|
73 u <- uses |
|
74 return $ Interface u (TypesAndVars "") |
|
75 |
|
76 program = do |
|
77 name <- programName |
|
78 spaces |
|
79 comments |
|
80 impl <- implementation |
|
81 return $ Program name impl (FunctionBody "") |
|
82 where |
|
83 programName = between (string "program") (char ';') identificator |
|
84 |
|
85 implementation = do |
|
86 u <- uses |
|
87 manyTill anyChar (try $ string "end.") |
|
88 return $ Implementation u (TypesAndVars "") (Functions []) |
|
89 |
|
90 uses = liftM Uses (option [] u) |
|
91 where |
|
92 u = do |
|
93 string "uses" |
|
94 spaces |
|
95 u <- (identificator >>= \i -> spaces >> return i) `sepBy1` (char ',' >> spaces) |
|
96 char ';' |
|
97 spaces |
|
98 return u |