# HG changeset patch # User unc0rr # Date 1320475037 -10800 # Node ID 627b5752733ad1085b6eec6a06d84fabecb4d077 # Parent f1b4f37dba2203cbeaeb0ef716286085423525e2 A try to improve parser move (has regressions) diff -r f1b4f37dba22 -r 627b5752733a hedgewars/uTypes.pas --- a/hedgewars/uTypes.pas Fri Nov 04 14:10:27 2011 +0300 +++ b/hedgewars/uTypes.pas Sat Nov 05 09:37:17 2011 +0300 @@ -32,7 +32,7 @@ type HwColor4f = record - r, g, b, a: byte + r, g, b, a: byte; end; // Possible states of the game diff -r f1b4f37dba22 -r 627b5752733a tools/PascalParser.hs --- a/tools/PascalParser.hs Fri Nov 04 14:10:27 2011 +0300 +++ b/tools/PascalParser.hs Sat Nov 05 09:37:17 2011 +0300 @@ -14,7 +14,6 @@ Program Identifier Implementation | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize) deriving Show - data Interface = Interface Uses TypesAndVars deriving Show data Implementation = Implementation Uses TypesAndVars @@ -23,16 +22,19 @@ deriving Show data TypesAndVars = TypesAndVars [TypeVarDeclaration] deriving Show -data TypeVarDeclaration = TypeDeclaration TypeDecl - | ConstDeclaration String - | VarDeclaration Bool String +data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl + | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe Expression) | FunctionDeclaration Identifier Identifier (Maybe Phrase) deriving Show data TypeDecl = SimpleType Identifier | RangeType Range + | Sequence [Identifier] | ArrayDecl Range TypeDecl + | RecordType [TypeVarDeclaration] + | UnknownType deriving Show -data Range = Range Identifier +data Range = Range Identifier + | RangeFromTo Expression Expression deriving Show data Initialize = Initialize String deriving Show @@ -51,12 +53,15 @@ | Assignment Reference Expression deriving Show data Expression = Expression String - | FunCall Identifier [Expression] + | FunCall Reference [Expression] | PrefixOp String Expression | PostfixOp String Expression | BinOp String Expression Expression | StringLiteral String + | CharCode String | NumberLiteral String + | HexNumber String + | Address Reference | Reference Reference deriving Show data Reference = ArrayElement Identifier Expression @@ -79,7 +84,7 @@ , "shr", "while", "do", "repeat", "until", "case", "of" , "type", "var", "const", "out", "array" , "procedure", "function", "with", "for", "to" - , "downto", "div", "mod" + , "downto", "div", "mod", "record", "set" ] , reservedOpNames= [] , caseSensitive = False @@ -87,7 +92,18 @@ pas = patch $ makeTokenParser pascalLanguageDef where - patch tp = tp {stringLiteral = between (char '\'') (char '\'') (many $ noneOf "'")} + patch tp = tp {stringLiteral = sl} + sl = do + (char '\'') + s <- (many $ noneOf "'") + (char '\'') + ss <- many $ do + (char '\'') + s' <- (many $ noneOf "'") + (char '\'') + return $ '\'' : s' + comments + return $ concat (s:ss) comments = do spaces @@ -136,12 +152,13 @@ , [Infix (char '.' >> return RecordField) AssocLeft] ] - -varsDecl endsWithSemi = do - vs <- many (try (aVarDecl >> semi pas) >> comments) - when (not endsWithSemi) $ aVarDecl >> return () +varsDecl1 = varsParser many1 +varsDecl = varsParser many +varsParser m endsWithSemi = do + vs <- m (aVarDecl >>= \i -> semi pas >> comments >> return i) + v <- if not endsWithSemi then liftM (\a -> [a]) aVarDecl else return [] comments - return $ VarDeclaration False $ show vs + return $ vs ++ v where aVarDecl = do when (not endsWithSemi) $ @@ -151,22 +168,32 @@ , try $ string "out" ] comments - ids <- (commaSep1 pas) $ (iD "variable declaration") - char ':' + ids <- try $ do + i <- (commaSep1 pas) $ (iD "variable declaration") + char ':' + return i + comments + t <- typeDecl "variable type declaration" comments - t <- typeDecl - comments - return (ids, t) + init <- option Nothing $ do + char '=' + comments + e <- expression + comments + char ';' + comments + return (Just e) + return $ VarDeclaration False (ids, t) init constsDecl = do - vs <- many (try (aConstDecl >> semi pas) >> comments) + vs <- many (try (aConstDecl >>= \i -> semi pas >> return i) >>= \i -> comments >> return i) comments - return $ VarDeclaration True $ show vs + return vs where aConstDecl = do comments - ids <- iD "const declaration" + i <- iD "const declaration" optional $ do char ':' comments @@ -176,11 +203,13 @@ comments e <- expression comments - return (ids, e) + return $ VarDeclaration False ([i], UnknownType) (Just e) typeDecl = choice [ arrayDecl + , recordDecl , rangeDecl >>= return . RangeType + , seqenceDecl >>= return . Sequence , identifier pas >>= return . SimpleType . Identifier ] "type declaration" where @@ -195,16 +224,44 @@ comments t <- typeDecl return $ ArrayDecl r t + recordDecl = do + try $ string "record" + comments + vs <- varsDecl True + string "end" + return $ RecordType vs + seqenceDecl = (parens pas) $ (commaSep pas) iD +typesDecl = many (aTypeDecl >>= \t -> comments >> return t) + where + aTypeDecl = do + i <- try $ do + i <- iD "type declaration" + comments + char '=' + return i + comments + t <- typeDecl + comments + semi pas + comments + return $ TypeDeclaration i t rangeDecl = choice [ - iD >>= return . Range + try $ rangeft + , iD >>= return . Range ] "range declaration" - + where + rangeft = do + e1 <- expression + string ".." + e2 <- expression + return $ RangeFromTo e1 e2 -typeVarDeclaration isImpl = choice [ +typeVarDeclaration isImpl = (liftM concat . many . choice) [ varSection, constSection, + typeSection, funcDecl, procDecl ] @@ -212,7 +269,7 @@ varSection = do try $ string "var" comments - v <- varsDecl True + v <- varsDecl1 True comments return v @@ -222,6 +279,13 @@ c <- constsDecl comments return c + + typeSection = do + try $ string "type" + comments + t <- typesDecl + comments + return t procDecl = do string "procedure" @@ -236,13 +300,13 @@ b <- if isImpl then do comments - optional $ typeVarDeclaration isImpl + optional $ typeVarDeclaration True comments liftM Just functionBody else return Nothing comments - return $ FunctionDeclaration i (Identifier "") b + return $ [FunctionDeclaration i (Identifier "") b] funcDecl = do string "function" @@ -260,12 +324,12 @@ b <- if isImpl then do comments - typeVarDeclaration isImpl + optional $ typeVarDeclaration True comments liftM Just functionBody else return Nothing - return $ FunctionDeclaration i ret Nothing + return $ [FunctionDeclaration i ret Nothing] program = do string "program" @@ -282,7 +346,7 @@ comments u <- uses comments - tv <- many (typeVarDeclaration False) + tv <- typeVarDeclaration False comments return $ Interface u (TypesAndVars tv) @@ -291,7 +355,7 @@ comments u <- uses comments - tv <- many (typeVarDeclaration True) + tv <- typeVarDeclaration True string "end." comments return $ Implementation u (TypesAndVars tv) @@ -302,6 +366,9 @@ parens pas $ expression , integer pas >>= return . NumberLiteral . show , stringLiteral pas >>= return . StringLiteral + , char '#' >> many digit >>= return . CharCode + , char '$' >> many hexDigit >>= return . HexNumber + , char '@' >> reference >>= return . Address , try $ funCall , reference >>= return . Reference ] "simple expression" @@ -451,9 +518,9 @@ return $ ProcCall i p funCall = do - i <- iD + r <- reference p <- (parens pas) $ option [] parameters - return $ FunCall i p + return $ FunCall r p parameters = (commaSep pas) expression "parameters" diff -r f1b4f37dba22 -r 627b5752733a tools/pas2c.hs --- a/tools/pas2c.hs Fri Nov 04 14:10:27 2011 +0300 +++ b/tools/pas2c.hs Sat Nov 05 09:37:17 2011 +0300 @@ -3,6 +3,7 @@ import PascalParser import Text.PrettyPrint.HughesPJ import Data.Maybe +import Data.Char pascal2C :: PascalUnit -> Doc @@ -36,7 +37,7 @@ where elsePart | isNothing mphrase2 = empty | otherwise = text "else" $$ (braces . nest 4 . phrase2C) (fromJust mphrase2) -phrase2C (Assignment (Identifier name) expr) = text name <> text " = " <> expr2C expr <> semi +phrase2C (Assignment ref expr) = ref2C ref <> text " = " <> expr2C expr <> semi phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ nest 4 (phrase2C phrase) phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $$ (nest 4 . vcat . map case2C) cases where @@ -50,14 +51,26 @@ -} phrase2C _ = empty +ref2C :: Reference -> Doc +ref2C (ArrayElement (Identifier name) expr) = text name <> brackets (expr2C expr) +ref2C (SimpleReference (Identifier name)) = text name +ref2C (RecordField ref1 ref2) = ref2C ref1 <> text "." <> ref2C ref2 +ref2C (Dereference ref) = parens $ text "*" <> ref2C ref expr2C :: Expression -> Doc expr2C (Expression s) = text s -expr2C (FunCall (Identifier name) params) = text name <> parens (hsep . punctuate (char ',') . map expr2C $ params) +expr2C (FunCall ref params) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params) expr2C (BinOp op expr1 expr2) = (expr2C expr1) <+> op2C op <+> (expr2C expr2) -{- | FunCall Identifier [Expression] +expr2C (NumberLiteral s) = text s +expr2C (HexNumber s) = text "0x" <> (text . map toLower $ s) +expr2C (StringLiteral s) = doubleQuotes $ text s +expr2C (Address ref) = text "&" <> ref2C ref +expr2C (Reference ref) = ref2C ref + +{- | PrefixOp String Expression - | BinOp String Expression Expression + | PostfixOp String Expression + | CharCode String -} expr2C _ = empty @@ -66,6 +79,7 @@ op2C "div" = text "/" op2C "mod" = text "%" op2C "<>" = text "!=" +op2C "=" = text "==" op2C a = text a maybeVoid "" = "void"