hedgewars: comparison tools/PascalParser.hs

equal deleted inserted replaced

-:a3b428e74410
+:1ef4192aa80d
 deriving Show
 data TypesAndVars = TypesAndVars [TypeVarDeclaration]
 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
+| ArrayDecl (Maybe Range) TypeDecl
-| RecordType [TypeVarDeclaration]
+| RecordType [TypeVarDeclaration] (Maybe [[TypeVarDeclaration]])
 | PointerTo TypeDecl
 | String Integer
+| Set TypeDecl
+| FunctionType TypeDecl [TypeVarDeclaration]
 | UnknownType
 deriving Show
 data Range = Range Identifier
 | RangeFromTo InitExpression InitExpression
 deriving Show
 table = [
 [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
 varsDecl = varsParser sepEndBy
 varsParser m endsWithSemi = do
 vs <- m (aVarDecl endsWithSemi) (semi pas)
 return vs
 aVarDecl endsWithSemi = do
-when (not endsWithSemi) $
+unless endsWithSemi $
 optional $ choice [
 try $ string "var"
 , try $ string "const"
 , try $ string "out"
 ]
 i <- iD <?> "const declaration"
 optional $ do
 char ':'
 comments
 t <- typeDecl
+comments
 return ()
 char '='
 comments
 e <- initExpression
 comments
 char '^' >> typeDecl >>= return . PointerTo
 , try (string "shortstring") >> return (String 255)
 , 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
-comments
+optional $ (try $ string "packed") >> comments
-char '['
+string "array"
-r <- rangeDecl
+comments
-char ']'
+r <- optionMaybe $ do
-comments
+char '['
+r <- rangeDecl
+char ']'
+comments
+return r
 string "of"
 comments
 t <- typeDecl
 return $ ArrayDecl r t
 recordDecl = do
-optional $ (try $ string "packed") >> comments
+try $ do
-try $ string "record"
+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
+return $ RecordType vs union
-sequenceDecl = (parens pas) $ (commaSep pas) iD
+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
 aTypeDecl = do
 i <- try $ do
 typeVarDeclaration isImpl = (liftM concat . many . choice) [
 varSection,
 constSection,
 typeSection,
-funcDecl,
+funcDecl
-procDecl
 ]
 where
 varSection = do
 try $ string "var"
 comments
 comments
 t <- typesDecl
 comments
 return t
-procDecl = do
+funcDecl = do
-try $ string "procedure"
+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 ret vs b]
-return $ [FunctionDeclaration i UnknownType b]
+functionDecorator = choice [
+try $ string "inline;"
-funcDecl = do
+, try $ string "cdecl;"
-try $ string "function"
+, try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";"
-comments
+] >> 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]
 program = do
 string "program"
 comments
 name <- iD
 (char ';')
 , Infix (try (string "mod") >> return (BinOp "mod")) AssocLeft
 ]
 , [  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
 , Infix (char '<' >> return (BinOp "<")) AssocNone
 , Infix (char '>' >> return (BinOp ">")) AssocNone
 , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
 ]
 , [  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
 try $ string "begin"
 comments
 string "then"
 comments
 o1 <- phrase
 comments
 o2 <- optionMaybe $ do
-try $ string "else"
+try $ string "else" >> space
 comments
 o <- phrase
 comments
 return o
 return $ IfThenElse e o1 o2
 comments
 o <- phrase
 return $ WhileCycle e o
 withBlock = do
-try $ string "with"
+try $ string "with" >> space
 comments
 rs <- (commaSep1 pas) reference
 comments
 string "do"
 comments
 o <- phrase
 return $ foldr WithBlock o rs
 repeatCycle = do
-try $ string "repeat"
+try $ string "repeat" >> space
 comments
 o <- many phrase
 string "until"
 comments
 e <- expression
 comments
 return $ RepeatCycle e o
 forCycle = do
-try $ string "for"
+try $ string "for" >> space
 comments
 i <- iD
 comments
 string ":="
 comments

changeset 6425	1ef4192aa80d
parent 6417	eae5900fd8a4
child 6426	2d44f6561e72