Mercurial Mercurial > hedgewars / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
tools/PascalParser.hs
changeset 6417 eae5900fd8a4
parent 6414 8474b7fa84d6
child 6425 1ef4192aa80d
equal deleted inserted replaced
6416:850b8dd3e6df 6417:eae5900fd8a4 
    12 import Data.Maybe
 
    12 import Data.Maybe
 
    13 
    13 
    14 import PascalBasics
 
    14 import PascalBasics
 
    15 
    15 
    16 data PascalUnit =
 
    16 data PascalUnit =
 
    17     Program Identifier Implementation
 
    17     Program Identifier Implementation Phrase
 
    18     | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
 
    18     | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
 
    19     deriving Show
 
    19     deriving Show
 
    20 data Interface = Interface Uses TypesAndVars
 
    20 data Interface = Interface Uses TypesAndVars
 
    21     deriving Show
 
    21     deriving Show
 
    22 data Implementation = Implementation Uses TypesAndVars
 
    22 data Implementation = Implementation Uses TypesAndVars
 
    25     deriving Show
 
    25     deriving Show
 
    26 data TypesAndVars = TypesAndVars [TypeVarDeclaration]
 
    26 data TypesAndVars = TypesAndVars [TypeVarDeclaration]
 
    27     deriving Show
 
    27     deriving Show
 
    28 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
 
    28 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
 
    29     | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression)
 
    29     | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression)
 
    30     | FunctionDeclaration Identifier TypeDecl (Maybe (TypesAndVars,Phrase))
 
    30     | FunctionDeclaration Identifier TypeDecl (Maybe (TypesAndVars, Phrase))
 
    31     deriving Show
 
    31     deriving Show
 
    32 data TypeDecl = SimpleType Identifier
 
    32 data TypeDecl = SimpleType Identifier
 
    33     | RangeType Range
 
    33     | RangeType Range
 
    34     | Sequence [Identifier]
 
    34     | Sequence [Identifier]
 
    35     | ArrayDecl Range TypeDecl
 
    35     | ArrayDecl Range TypeDecl
 
    52         | WhileCycle Expression Phrase
 
    52         | WhileCycle Expression Phrase
 
    53         | RepeatCycle Expression [Phrase]
 
    53         | RepeatCycle Expression [Phrase]
 
    54         | ForCycle Identifier Expression Expression Phrase
 
    54         | ForCycle Identifier Expression Expression Phrase
 
    55         | WithBlock Reference Phrase
 
    55         | WithBlock Reference Phrase
 
    56         | Phrases [Phrase]
 
    56         | Phrases [Phrase]
 
    57         | SwitchCase Expression [(Expression, Phrase)] (Maybe Phrase)
 
    57         | SwitchCase Expression [([Expression], Phrase)] (Maybe Phrase)
 
    58         | Assignment Reference Expression
 
    58         | Assignment Reference Expression
 
    59     deriving Show
 
    59     deriving Show
 
    60 data Expression = Expression String
 
    60 data Expression = Expression String
 
    61     | BuiltInFunCall [Expression] Reference
 
    61     | BuiltInFunCall [Expression] Reference
 
    62     | PrefixOp String Expression
 
    62     | PrefixOp String Expression
 
   276         i <- iD
 
   276         i <- iD
 
   277         optional $ parens pas $ varsDecl False
 
   277         optional $ parens pas $ varsDecl False
 
   278         comments
 
   278         comments
 
   279         char ';'
 
   279         char ';'
 
   280         comments
 
   280         comments
 
   281         b <- if isImpl then
 
   281         forward <- liftM isJust $ optionMaybe ((try $ string "forward;") >> comments)
 
       
   282         b <- if isImpl && (not forward) then
 
   282                 liftM Just functionBody
 
   283                 liftM Just functionBody
 
   283                 else
 
   284                 else
 
   284                 return Nothing
 
   285                 return Nothing
 
   285         comments
 
   286 --        comments
 
   286         return $ [FunctionDeclaration i UnknownType b]
 
   287         return $ [FunctionDeclaration i UnknownType b]
 
   287         
   288         
   288     funcDecl = do
 
   289     funcDecl = do
 
   289         try $ string "function"
 
   290         try $ string "function"
 
   290         comments
 
   291         comments
 
   295         comments
 
   296         comments
 
   296         ret <- typeDecl
 
   297         ret <- typeDecl
 
   297         comments
 
   298         comments
 
   298         char ';'
 
   299         char ';'
 
   299         comments
 
   300         comments
 
   300         b <- if isImpl then
 
   301         forward <- liftM isJust $ optionMaybe ((try $ string "forward;") >> comments)
 
       
   302         b <- if isImpl && (not forward) then
 
   301                 liftM Just functionBody
 
   303                 liftM Just functionBody
 
   302                 else
 
   304                 else
 
   303                 return Nothing
 
   305                 return Nothing
 
   304         return $ [FunctionDeclaration i ret b]
 
   306         return $ [FunctionDeclaration i ret b]
 
   305 
   307 
   307     string "program"
 
   309     string "program"
 
   308     comments
 
   310     comments
 
   309     name <- iD
 
   311     name <- iD
 
   310     (char ';')
 
   312     (char ';')
 
   311     comments
 
   313     comments
 
   312     impl <- implementation
 
   314     comments
 
   313     comments
 
   315     u <- uses
 
   314     return $ Program name impl
 
   316     comments
 
       
   317     tv <- typeVarDeclaration True
 
       
   318     comments
 
       
   319     p <- phrase
 
       
   320     comments
 
       
   321     char '.'
 
       
   322     comments
 
       
   323     return $ Program name (Implementation u (TypesAndVars tv)) p
 
   315 
   324 
   316 interface = do
 
   325 interface = do
 
   317     string "interface"
 
   326     string "interface"
 
   318     comments
 
   327     comments
 
   319     u <- uses
 
   328     u <- uses
 
   339         , parens pas $ expression 
   348         , parens pas $ expression 
   340         , try $ natural pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i
 
   349         , try $ natural pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i
 
   341         , try $ float pas >>= return . FloatLiteral . show
 
   350         , try $ float pas >>= return . FloatLiteral . show
 
   342         , try $ natural pas >>= return . NumberLiteral . show
 
   351         , try $ natural pas >>= return . NumberLiteral . show
 
   343         , stringLiteral pas >>= return . StringLiteral
 
   352         , stringLiteral pas >>= return . StringLiteral
 
   344         , char '#' >> many digit >>= return . CharCode
 
   353         , char '#' >> many digit >>= \c -> comments >> return (CharCode c)
 
   345         , char '$' >> many hexDigit >>= return . HexNumber
 
   354         , char '$' >> many hexDigit >>=  \h -> comments >> return (HexNumber h)
 
   346         , char '-' >> expression >>= return . PrefixOp "-"
 
   355         , char '-' >> expression >>= return . PrefixOp "-"
 
   347         , try $ string "nil" >> return Null
 
   356         , try $ string "nil" >> return Null
 
   348         , reference >>= return . Reference
 
   357         , reference >>= return . Reference
 
   349         ] <?> "simple expression"
 
   358         ] <?> "simple expression"
 
   350 
   359 
   480     string "end"
 
   489     string "end"
 
   481     comments
 
   490     comments
 
   482     return $ SwitchCase e cs o2
 
   491     return $ SwitchCase e cs o2
 
   483     where
 
   492     where
 
   484     aCase = do
 
   493     aCase = do
 
   485         e <- expression
 
   494         e <- (commaSep pas) expression
 
   486         comments
 
   495         comments
 
   487         char ':'
 
   496         char ':'
 
   488         comments
 
   497         comments
 
   489         p <- phrase
 
   498         p <- phrase
 
   490         comments
 
   499         comments
 
   572     name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin
 
   581     name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin
 
   573     spaces
 
   582     spaces
 
   574     exprs <- parens pas $ commaSep1 pas $ e
 
   583     exprs <- parens pas $ commaSep1 pas $ e
 
   575     spaces
 
   584     spaces
 
   576     return (name, exprs)
 
   585     return (name, exprs)
 
       
   586
hedgewars