diff -r d8f62c805619 -r 734fed7aefd3 tools/PascalParser.hs --- a/tools/PascalParser.hs Sun Nov 13 18:23:05 2011 +0100 +++ b/tools/PascalParser.hs Sun Nov 13 13:46:26 2011 +0300 @@ -23,7 +23,7 @@ data TypesAndVars = TypesAndVars [TypeVarDeclaration] deriving Show data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl - | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe Expression) + | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression) | FunctionDeclaration Identifier TypeDecl (Maybe Phrase) deriving Show data TypeDecl = SimpleType Identifier @@ -49,7 +49,7 @@ | WhileCycle Expression Phrase | RepeatCycle Expression [Phrase] | ForCycle Identifier Expression Expression Phrase - | WithBlock Expression Phrase + | WithBlock Reference Phrase | Phrases [Phrase] | SwitchCase Expression [(Expression, Phrase)] (Maybe Phrase) | Assignment Reference Expression @@ -72,6 +72,18 @@ | RecordField Reference Reference | Address Reference deriving Show +data InitExpression = InitBinOp String InitExpression InitExpression + | InitPrefixOp String InitExpression + | InitReference Identifier + | InitArray [InitExpression] + | InitRecord [(Identifier, InitExpression)] + | InitFloat String + | InitNumber String + | InitHexNumber String + | InitString String + | InitChar String + | InitNull + deriving Show pascalLanguageDef = emptyDef @@ -183,7 +195,7 @@ init <- option Nothing $ do char '=' comments - e <- expression + e <- initExpression comments return (Just e) return $ VarDeclaration False (ids, t) init @@ -204,7 +216,7 @@ return () char '=' comments - e <- expression + e <- initExpression comments return $ VarDeclaration False ([i], UnknownType) (Just e) @@ -213,9 +225,9 @@ , try (string "shortstring") >> return String , arrayDecl , recordDecl + , sequenceDecl >>= return . Sequence + , try (identifier pas) >>= return . SimpleType . Identifier , rangeDecl >>= return . RangeType - , sequenceDecl >>= return . Sequence - , identifier pas >>= return . SimpleType . Identifier ] "type declaration" where arrayDecl = do @@ -336,7 +348,7 @@ liftM Just functionBody else return Nothing - return $ [FunctionDeclaration i ret Nothing] + return $ [FunctionDeclaration i ret b] program = do string "program" @@ -400,8 +412,8 @@ , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft ] - , [ Infix (try $ string "shl" >> return (BinOp "and")) AssocNone - , Infix (try $ string "shr" >> return (BinOp "or")) AssocNone + , [ Infix (try $ string "shl" >> return (BinOp "shl")) AssocNone + , Infix (try $ string "shr" >> return (BinOp "shr")) AssocNone ] , [Prefix (try (string "not") >> return (PrefixOp "not"))] ] @@ -459,12 +471,12 @@ withBlock = do try $ string "with" comments - e <- expression + r <- reference comments string "do" comments o <- phrase - return $ WithBlock e o + return $ WithBlock r o repeatCycle = do try $ string "repeat" @@ -543,3 +555,54 @@ char ';' comments return u + +initExpression = buildExpressionParser table term "initialization expression" + where + term = comments >> choice [ + try $ parens pas (commaSep pas $ initExpression) >>= return . InitArray + , parens pas (semiSep pas $ recField) >>= return . InitRecord + , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . InitNumber . show) i + , try $ float pas >>= return . InitFloat . show + , stringLiteral pas >>= return . InitString + , char '#' >> many digit >>= return . InitChar + , char '$' >> many hexDigit >>= return . InitHexNumber + , try $ string "nil" >> return InitNull + , iD >>= return . InitReference + ] + + recField = do + i <- iD + spaces + char ':' + spaces + e <- initExpression + spaces + return (i ,e) + + table = [ + [ Infix (char '*' >> return (InitBinOp "*")) AssocLeft + , Infix (char '/' >> return (InitBinOp "/")) AssocLeft + , Infix (try (string "div") >> return (InitBinOp "div")) AssocLeft + , Infix (try (string "mod") >> return (InitBinOp "mod")) AssocLeft + ] + , [ Infix (char '+' >> return (InitBinOp "+")) AssocLeft + , Infix (char '-' >> return (InitBinOp "-")) AssocLeft + , Prefix (char '-' >> return (InitPrefixOp "-")) + ] + , [ Infix (try (string "<>") >> return (InitBinOp "<>")) AssocNone + , Infix (try (string "<=") >> return (InitBinOp "<=")) AssocNone + , Infix (try (string ">=") >> return (InitBinOp ">=")) AssocNone + , Infix (char '<' >> return (InitBinOp "<")) AssocNone + , Infix (char '>' >> return (InitBinOp ">")) AssocNone + , Infix (char '=' >> return (InitBinOp "=")) AssocNone + ] + , [ Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft + , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft + , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft + ] + , [ Infix (try $ string "shl" >> return (InitBinOp "and")) AssocNone + , Infix (try $ string "shr" >> return (InitBinOp "or")) AssocNone + ] + , [Prefix (try (string "not") >> return (InitPrefixOp "not"))] + ] + \ No newline at end of file