--- a/tools/PascalParser.hs Fri Nov 25 05:15:38 2011 +0100
+++ b/tools/PascalParser.hs Fri Nov 25 18:36:12 2011 +0300
@@ -27,15 +27,17 @@
deriving Show
data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
| VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression)
- | FunctionDeclaration Identifier TypeDecl (Maybe (TypesAndVars, Phrase))
+ | FunctionDeclaration Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
deriving Show
data TypeDecl = SimpleType Identifier
| RangeType Range
| Sequence [Identifier]
- | ArrayDecl Range TypeDecl
- | RecordType [TypeVarDeclaration]
+ | ArrayDecl (Maybe Range) TypeDecl
+ | RecordType [TypeVarDeclaration] (Maybe [[TypeVarDeclaration]])
| PointerTo TypeDecl
| String Integer
+ | Set TypeDecl
+ | FunctionType TypeDecl [TypeVarDeclaration]
| UnknownType
deriving Show
data Range = Range Identifier
@@ -126,13 +128,12 @@
[Infix (try (char '.' >> notFollowedBy (char '.')) >> return RecordField) AssocLeft]
]
- postfixes r = many postfix >>= return . foldl fp r
+ postfixes r = many postfix >>= return . foldl (flip ($)) r
postfix = choice [
parens pas (option [] parameters) >>= return . FunCall
, char '^' >> return Dereference
, (brackets pas) (commaSep1 pas $ expression) >>= return . ArrayElement
]
- fp r f = f r
varsDecl1 = varsParser sepEndBy1
@@ -142,7 +143,7 @@
return vs
aVarDecl endsWithSemi = do
- when (not endsWithSemi) $
+ unless endsWithSemi $
optional $ choice [
try $ string "var"
, try $ string "const"
@@ -177,6 +178,7 @@
char ':'
comments
t <- typeDecl
+ comments
return ()
char '='
comments
@@ -190,30 +192,75 @@
, try (string "string") >> optionMaybe (brackets pas $ integer pas) >>= return . String . fromMaybe 255
, arrayDecl
, recordDecl
+ , setDecl
+ , functionType
, sequenceDecl >>= return . Sequence
, try (identifier pas) >>= return . SimpleType . Identifier
, rangeDecl >>= return . RangeType
] <?> "type declaration"
where
arrayDecl = do
- try $ string "array"
+ try $ do
+ optional $ (try $ string "packed") >> comments
+ string "array"
comments
- char '['
- r <- rangeDecl
- char ']'
- comments
+ r <- optionMaybe $ do
+ char '['
+ r <- rangeDecl
+ char ']'
+ comments
+ return r
string "of"
comments
t <- typeDecl
return $ ArrayDecl r t
recordDecl = do
- optional $ (try $ string "packed") >> comments
- try $ string "record"
+ try $ do
+ optional $ (try $ string "packed") >> comments
+ string "record"
comments
vs <- varsDecl True
+ union <- optionMaybe $ do
+ string "case"
+ comments
+ iD
+ comments
+ string "of"
+ comments
+ many unionCase
string "end"
- return $ RecordType vs
- sequenceDecl = (parens pas) $ (commaSep pas) iD
+ return $ RecordType vs union
+ setDecl = do
+ try $ string "set" >> space
+ comments
+ string "of"
+ comments
+ liftM Set typeDecl
+ unionCase = do
+ try $ commaSep pas $ (iD >> return ()) <|> (integer pas >> return ())
+ char ':'
+ comments
+ u <- parens pas $ varsDecl True
+ char ';'
+ comments
+ return u
+ sequenceDecl = (parens pas) $ (commaSep pas) (iD >>= \i -> optional (spaces >> char '=' >> spaces >> integer pas) >> return i)
+ functionType = do
+ fp <- try (string "function") <|> try (string "procedure")
+ comments
+ vs <- option [] $ parens pas $ varsDecl False
+ comments
+ ret <- if (fp == "function") then do
+ char ':'
+ comments
+ ret <- typeDecl
+ comments
+ return ret
+ else
+ return UnknownType
+ optional $ try $ char ';' >> comments >> string "cdecl"
+ comments
+ return $ FunctionType ret vs
typesDecl = many (aTypeDecl >>= \t -> comments >> return t)
where
@@ -245,8 +292,7 @@
varSection,
constSection,
typeSection,
- funcDecl,
- procDecl
+ funcDecl
]
where
varSection = do
@@ -270,41 +316,34 @@
comments
return t
- procDecl = do
- try $ string "procedure"
+ funcDecl = do
+ fp <- try (string "function") <|> try (string "procedure")
comments
i <- iD
- optional $ parens pas $ varsDecl False
+ vs <- option [] $ parens pas $ varsDecl False
comments
+ ret <- if (fp == "function") then do
+ char ':'
+ comments
+ ret <- typeDecl
+ comments
+ return ret
+ else
+ return UnknownType
char ';'
comments
- forward <- liftM isJust $ optionMaybe ((try $ string "forward;") >> comments)
+ forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
+ many functionDecorator
b <- if isImpl && (not forward) then
liftM Just functionBody
else
return Nothing
--- comments
- return $ [FunctionDeclaration i UnknownType b]
-
- funcDecl = do
- try $ string "function"
- comments
- i <- iD
- optional $ parens pas $ varsDecl False
- comments
- char ':'
- comments
- ret <- typeDecl
- comments
- char ';'
- comments
- forward <- liftM isJust $ optionMaybe ((try $ string "forward;") >> comments)
- b <- if isImpl && (not forward) then
- liftM Just functionBody
- else
- return Nothing
- return $ [FunctionDeclaration i ret b]
-
+ return $ [FunctionDeclaration i ret vs b]
+ functionDecorator = choice [
+ try $ string "inline;"
+ , try $ string "cdecl;"
+ , try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";"
+ ] >> comments
program = do
string "program"
comments
@@ -366,6 +405,7 @@
, [ Infix (char '+' >> return (BinOp "+")) AssocLeft
, Infix (char '-' >> return (BinOp "-")) AssocLeft
]
+ , [Prefix (try (string "not") >> return (PrefixOp "not"))]
, [ Infix (try (string "<>") >> return (BinOp "<>")) AssocNone
, Infix (try (string "<=") >> return (BinOp "<=")) AssocNone
, Infix (try (string ">=") >> return (BinOp ">=")) AssocNone
@@ -380,7 +420,6 @@
, [ Infix (try $ string "shl" >> return (BinOp "shl")) AssocNone
, Infix (try $ string "shr" >> return (BinOp "shr")) AssocNone
]
- , [Prefix (try (string "not") >> return (PrefixOp "not"))]
]
phrasesBlock = do
@@ -416,7 +455,7 @@
o1 <- phrase
comments
o2 <- optionMaybe $ do
- try $ string "else"
+ try $ string "else" >> space
comments
o <- phrase
comments
@@ -434,7 +473,7 @@
return $ WhileCycle e o
withBlock = do
- try $ string "with"
+ try $ string "with" >> space
comments
rs <- (commaSep1 pas) reference
comments
@@ -444,7 +483,7 @@
return $ foldr WithBlock o rs
repeatCycle = do
- try $ string "repeat"
+ try $ string "repeat" >> space
comments
o <- many phrase
string "until"
@@ -454,7 +493,7 @@
return $ RepeatCycle e o
forCycle = do
- try $ string "for"
+ try $ string "for" >> space
comments
i <- iD
comments