hedgewars: comparison tools/PascalParser.hs

equal deleted inserted replaced

-:7c6f9b6672dc
+:11c578d30bd3
 import PascalBasics
 data PascalUnit =
 Program Identifier Implementation Phrase
 | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
+| System
 deriving Show
 data Interface = Interface Uses TypesAndVars
 deriving Show
 data Implementation = Implementation Uses TypesAndVars
 deriving Show
 | WhileCycle Expression Phrase
 | RepeatCycle Expression [Phrase]
 | ForCycle Identifier Expression Expression Phrase
 | WithBlock Reference Phrase
 | Phrases [Phrase]
-| SwitchCase Expression [([InitExpression], Phrase)] (Maybe Phrase)
+| SwitchCase Expression [([InitExpression], Phrase)] (Maybe [Phrase])
 | Assignment Reference Expression
 | NOP
 deriving Show
 data Expression = Expression String
 | BuiltInFunCall [Expression] Reference
 | SetExpression [Identifier]
 | Null
 deriving Show
 data Reference = ArrayElement [Expression] Reference
 | FunCall [Expression] Reference
-| TypeCast Identifier Reference
+| TypeCast Identifier Expression
 | SimpleReference Identifier
 | Dereference Reference
 | RecordField Reference Reference
 | Address Reference
+| RefExpression Expression
 deriving Show
 data InitExpression = InitBinOp String InitExpression InitExpression
 | InitPrefixOp String InitExpression
 | InitReference Identifier
 | InitArray [InitExpression]
 | InitNumber String
 | InitHexNumber String
 | InitString String
 | InitChar String
 | BuiltInFunction String [InitExpression]
-| InitSet [Identifier]
+| InitSet [InitExpression]
+| InitAddress InitExpression
 | InitNull
-deriving Show
+| InitRange Range
+| InitTypeCast Identifier InitExpression
-knownTypes = ["shortstring"]
+deriving Show
+knownTypes = ["shortstring", "char", "byte"]
 pascalUnit = do
 comments
 u <- choice [program, unit]
 comments
 reference = buildExpressionParser table term <?> "reference"
 where
 term = comments >> choice [
-parens pas (reference >>= postfixes) >>= postfixes
+parens pas (liftM RefExpression expression >>= postfixes) >>= postfixes
-, typeCast >>= postfixes
+, try $ typeCast >>= postfixes
 , char '@' >> liftM Address reference >>= postfixes
 , liftM SimpleReference iD >>= postfixes
 ] <?> "simple reference"
 table = [
-[Infix (try (char '.' >> notFollowedBy (char '.')) >> return RecordField) AssocLeft]
 ]
 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
+, (char '.' >> notFollowedBy (char '.')) >> liftM RecordField reference
 ]
 typeCast = do
 t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes
-r <- parens pas reference
+e <- parens pas expression
 comments
-return $ TypeCast (Identifier t) r
+return $ TypeCast (Identifier t) e
 varsDecl1 = varsParser sepEndBy1
 varsDecl = varsParser sepEndBy
 varsParser m endsWithSemi = do
 t <- typeDecl
 comments
 semi pas
 comments
 return $ TypeDeclaration i t
 rangeDecl = choice [
 try $ rangeft
 , iD >>= return . Range
 ] <?> "range declaration"
 where
 rangeft = do
 e1 <- initExpression
 string ".."
 e2 <- initExpression
 return $ RangeFromTo e1 e2
 typeVarDeclaration isImpl = (liftM concat . many . choice) [
 varSection,
 constSection,
 typeSection,
 return Nothing
 return $ [FunctionDeclaration i ret vs b]
 functionDecorator = choice [
 try $ string "inline;"
-, try $ string "cdecl;"
+, try $ caseInsensitiveString "cdecl;"
 , try $ string "overload;"
+, try $ string "export;"
+, try $ string "varargs;"
 , try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";"
 ] >> comments
 program = do
 expression = buildExpressionParser table term <?> "expression"
 where
 term = comments >> choice [
 builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n))
-, parens pas $ expression
+, try (parens pas $ expression >>= \e -> notFollowedBy (comments >> char '.') >> return e)
 , brackets pas (commaSep pas iD) >>= return . SetExpression
 , try $ natural pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i
 , float pas >>= return . FloatLiteral . show
 , natural pas >>= return . NumberLiteral . show
 , stringLiteral pas >>= return . StringLiteral
 , switchCase
 , withBlock
 , forCycle
 , (try $ reference >>= \r -> string ":=" >> return r) >>= \r -> expression >>= return . Assignment r
 , procCall
+, char ';' >> comments >> return NOP
 ]
 optional $ char ';'
 comments
 return o
 comments
 cs <- many1 aCase
 o2 <- optionMaybe $ do
 try $ string "else" >> notFollowedBy alphaNum
 comments
-o <- phrase
+o <- many phrase
 comments
 return o
 string "end"
 comments
 return $ SwitchCase e cs o2
 where
 aCase = do
-e <- (commaSep pas) initExpression
+e <- (commaSep pas) $ (liftM InitRange rangeDecl <|> initExpression)
 comments
 char ':'
 comments
 p <- phrase
 comments
 initExpression = buildExpressionParser table term <?> "initialization expression"
 where
 term = comments >> choice [
 liftM (uncurry BuiltInFunction) $ builtInFunction initExpression
-, try $ brackets pas (commaSep pas $ iD) >>= return . InitSet
+, try $ brackets pas (commaSep pas $ initExpression) >>= return . InitSet
 , try $ parens pas (commaSep pas $ initExpression) >>= return . InitArray
-, parens pas (semiSep pas $ recField) >>= return . InitRecord
+, parens pas (sepEndBy recField (char ';' >> comments)) >>= return . InitRecord
 , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . InitNumber . show) i
 , try $ float pas >>= return . InitFloat . show
 , try $ integer pas >>= return . InitNumber . show
 , stringLiteral pas >>= return . InitString
 , char '#' >> many digit >>= \c -> comments >> return (InitChar c)
 , char '$' >> many hexDigit >>= \h -> comments >> return (InitHexNumber h)
+, char '@' >> initExpression >>= \c -> comments >> return (InitAddress c)
 , try $ string "nil" >> return InitNull
+, itypeCast
 , iD >>= return . InitReference
 ]
 recField = do
 i <- iD
 , Infix (try $ string "shr" >> return (InitBinOp "or")) AssocNone
 ]
 , [Prefix (try (string "not") >> return (InitPrefixOp "not"))]
 ]
+itypeCast = do
+t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes
+i <- parens pas initExpression
+comments
+return $ InitTypeCast (Identifier t) i
 builtInFunction e = do
 name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin
 spaces
 exprs <- parens pas $ commaSep1 pas $ e
 spaces

changeset 6453	11c578d30bd3
parent 6452	7c6f9b6672dc
child 6467	090269e528df