--- 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