From 87a04f03c45e285916223011d752251df63d015d Mon Sep 17 00:00:00 2001 From: Francis Russell Date: Mon, 17 Dec 2012 01:48:18 +0000 Subject: [PATCH] Clean up use of do notation in parser. --- OFC/Parser.hs | 185 +++++++++++++++++++++++--------------------------- src/Main.hs | 6 +- 2 files changed, 87 insertions(+), 104 deletions(-) diff --git a/OFC/Parser.hs b/OFC/Parser.hs index 86c5504..158f93b 100644 --- a/OFC/Parser.hs +++ b/OFC/Parser.hs @@ -1,18 +1,22 @@ module OFC.Parser (runOFLParser) where import OFC.Common -import OFC.TopLevel import OFC.TargetMapping +import OFC.TopLevel + +import Control.Applicative ((<$>)) +import Control.Monad (forM_) import Data.Functor.Identity (Identity) import Text.Parsec import Text.Parsec.Expr -import Text.Parsec.Token import Text.Parsec.Language +import Text.Parsec.Token oflKeywords :: [String] oflKeywords = map toOFLString [minBound::IndexType ..] ++ map toOFLString [minBound::BaseType ..] ++ - ["^", "+", "-", "*", "/", "=", "laplacian", "inner", "sum", "derivative", "r", "target"] + [ "^", "+", "-", "*", "/", "=", "laplacian", "inner", "sum", "derivative" + , "r", "target"] oflDef :: LanguageDef st oflDef = emptyDef { @@ -40,20 +44,20 @@ TokenParser { } = makeTokenParser oflDef oflOperatorTable :: OperatorTable String st Identity Expression -oflOperatorTable = [[Infix (do _ <- lSymbol "^"; return Power) AssocRight], - [Prefix (do _ <- lSymbol "-"; return Negate)], - [Infix (do _ <- lSymbol "*"; return Multiply) AssocLeft - ,Infix (do _ <- lSymbol "/"; return Divide) AssocLeft], - [Infix (do _ <- lSymbol "+"; return Add) AssocLeft - ,Infix (do _ <- lSymbol "-"; return Sub) AssocLeft] +oflOperatorTable = [ [ Infix (lSymbol "^" >> return Power) AssocRight ] + , [ Prefix (lSymbol "-" >> return Negate) ] + , [ Infix (lSymbol "*" >> return Multiply) AssocLeft + , Infix (lSymbol "/" >> return Divide) AssocLeft + ] + , [ Infix (lSymbol "+" >> return Add) AssocLeft + , Infix (lSymbol "-" >> return Sub) AssocLeft + ] ] type OFLParser a = Parsec String OFL a parseKeyword :: (OFLKeyword a) => a -> OFLParser a -parseKeyword k = do - lReserved $ toOFLString k - return k +parseKeyword k = (lReserved $ toOFLString k) >> return k parseType :: OFLParser BaseType parseType = choice $ map parseKeyword [minBound::BaseType ..] @@ -62,21 +66,22 @@ parseIndex :: OFLParser IndexType parseIndex = choice $ map parseKeyword [minBound::IndexType ..] parseDeclaration :: OFLParser () -parseDeclaration = parseValueDeclaration <|> parseIndexDeclaration "declaration" +parseDeclaration = parseValueDeclaration <|> parseIndexDeclaration + "declaration" parseValueDeclaration :: OFLParser () parseValueDeclaration = do valueType <- parseType indices <- option [] (lBrackets $ lCommaSep parseIndex) names <- lCommaSep1 parseIdentifier - sequence_ [modifyState(\x -> addValueDeclaration x name valueType indices) | name <- names] + forM_ names (\name -> modifyState (\ofl -> addValueDeclaration ofl name valueType indices)) "value declaration" parseIndexDeclaration :: OFLParser () parseIndexDeclaration = do indexType <- parseIndex names <- lCommaSep1 parseIdentifier - sequence_ [modifyState(\x -> addIndexDeclaration x name indexType) | name <- names] + forM_ names (\name -> modifyState (\ofl -> addIndexDeclaration ofl name indexType)) "index declaration" parseIdentifier :: OFLParser String @@ -87,19 +92,20 @@ parseAssignment = do lhs <- parseExpression _ <- lSymbol "=" rhs <- parseExpression - modifyState(\x -> addAssignment x lhs rhs) + modifyState (\ofl -> addAssignment ofl lhs rhs) "assignment" parseExpression :: OFLParser Expression -parseExpression = buildExpressionParser oflOperatorTable parseTerm "expression" +parseExpression = buildExpressionParser oflOperatorTable parseTerm + "expression" parseTerm :: OFLParser Expression parseTerm = parseLaplacian - <|> do lReserved "inner"; res <- lParens parseInner; return res - <|> do lReserved "sum"; res <- lParens parseSum; return res - <|> do lReserved "derivative"; res <- lParens parseDerivative; return res - <|> do lReserved "r"; index <- lBrackets parseIdentifier; return $ PositionComponent index + <|> (lReserved "inner" >> lParens parseInner) + <|> (lReserved "sum" >> lParens parseSum) + <|> (lReserved "derivative" >> lParens parseDerivative) + <|> (lReserved "r" >> PositionComponent <$> lBrackets parseIdentifier) <|> do number <- lNaturalOrFloat return $ case number of Left i -> ConstInteger i @@ -117,16 +123,14 @@ parseLaplacian = do indexName = findUniqueName ofl "laplacian" secondDerivative = SpatialDerivative operand indexName 2 ofl' = addInternalIndexDeclaration ofl indexName SpatialIndex in - do - putState ofl'; - return $ Sum secondDerivative indexName + putState ofl' >> (return $ Sum secondDerivative indexName) parseInner :: OFLParser Expression parseInner = do e1 <- parseExpression _ <- lSymbol "," e2 <- parseExpression - return $ Integrate $ Multiply e1 e2 + return $ Integrate $ Multiply e1 e2 "inner product" parseSum :: OFLParser Expression @@ -153,19 +157,17 @@ parseIdentifierAccess = do "indexed identifier" parseTarget :: OFLParser String -parseTarget = do - lReserved "target" - lSymbol "ONETEP" +parseTarget = lReserved "target" >> lSymbol "ONETEP" parseOFL :: OFLParser OFL -parseOFL = do - lWhiteSpace - _ <- many1 parseDeclaration - _ <- many1 parseAssignment - _ <- parseTarget - _ <- many parseBinding - _ <- parseOutputFunction - eof +parseOFL = + lWhiteSpace >> + many1 parseDeclaration >> + many1 parseAssignment >> + parseTarget >> + many parseBinding >> + parseOutputFunction >> + eof >> getState parseOutputFunction :: OFLParser () @@ -176,21 +178,19 @@ parseOutputFunction = do _ <- lSymbol "fortran_function" _ <- lSymbol "with" properties <- lCommaSep parseFortranFunctionProperty - modifyState(\x -> setOutputFunction x $ FortranFunction ident properties) + modifyState(\ofl -> setOutputFunction ofl $ FortranFunction ident properties) "output function specification" parseFortranFunctionProperty :: OFLParser FortranFunctionProperty -parseFortranFunctionProperty = do +parseFortranFunctionProperty = parseFortranFunctionNameProperty <|> parseFortranFunctionParamsProperty where - parseFortranFunctionNameProperty = do - _ <- lSymbol "name" - name <- lParens lStringLiteral - return $ FortranFunctionName name - parseFortranFunctionParamsProperty = do - _ <- lSymbol "params" - idents <- lParens $ lCommaSep lIdentifier - return $ FortranFunctionParams idents + parseFortranFunctionNameProperty = + lSymbol "name" >> + FortranFunctionName <$> lParens lStringLiteral + parseFortranFunctionParamsProperty = + lSymbol "params" >> + FortranFunctionParams <$> (lParens $ lCommaSep lIdentifier) parseBinding :: OFLParser () parseBinding = do @@ -198,14 +198,13 @@ parseBinding = do ident <- parseIdentifier _ <- lSymbol "=" targetType <- (parseFortranParam <|> parsePPDFunctionSet) - modifyState(\x -> addTargetMapping x ident targetType) + modifyState(\ofl -> addTargetMapping ofl ident targetType) parseFortranParam :: OFLParser TargetType -parseFortranParam = do - _ <- lSymbol "fortran_param" - _ <- lSymbol "with" - properties <- lCommaSep parseFortranParamProperty - return $ FortranParameter properties +parseFortranParam = + lSymbol "fortran_param" >> + lSymbol "with" >> + FortranParameter <$> lCommaSep parseFortranParamProperty parseFortranParamProperty :: OFLParser FortranParamProperty parseFortranParamProperty = @@ -214,31 +213,25 @@ parseFortranParamProperty = <|> parseSpaceProperty <|> parseIndexedProperty "Fortran parameter property" where - parseNameProperty = do - _ <- lSymbol "name" - name <- lParens lStringLiteral - return $ ParamName name - parseTypeProperty = do - _ <- lSymbol "type" - fType <- lParens parseFortranType - return $ ParamType fType - parseSpaceProperty = do - _ <- lSymbol "space" - info <- lParens parseSpaceInfo - return $ Space info + parseNameProperty = + lSymbol "name" >> + ParamName <$> lParens lStringLiteral + parseTypeProperty = + lSymbol "type" >> + ParamType <$> lParens parseFortranType + parseSpaceProperty = + lSymbol "space" >> + Space <$> lParens parseSpaceInfo parseSpaceInfo = parseFineGrid <|> parseCoarseGrid - parseFineGrid = do - _ <- lSymbol "psinc_fine_grid" - indices <- lParens $ lCommaSep1 lIdentifier - return $ FinePsinc indices - parseCoarseGrid = do - _ <- lSymbol "psinc_coarse_grid" - indices <- lParens $ lCommaSep1 lIdentifier - return $ CoarsePsinc indices - parseIndexedProperty = do - _ <- lSymbol "indexed" - indices <- lParens $ lCommaSep1 lIdentifier - return $ Indexed indices + parseFineGrid = + lSymbol "psinc_fine_grid" >> + FinePsinc <$> lParens (lCommaSep1 lIdentifier) + parseCoarseGrid = + lSymbol "psinc_coarse_grid" >> + CoarsePsinc <$> lParens (lCommaSep1 lIdentifier) + parseIndexedProperty = + lSymbol "indexed" >> + Indexed <$> lParens (lCommaSep1 lIdentifier) parseFortranType :: OFLParser FortranType parseFortranType = do @@ -248,38 +241,30 @@ parseFortranType = do Nothing -> return baseType Just indices -> return $ Array baseType indices where - parseArrayIndices = do - indices <- lParens $ lCommaSep1 parseArrayIndex - return indices - parseArrayIndex = do - _ <- lSymbol ":"; return UnnamedIndex - <|> do name <- lIdentifier; return $ NamedIndex name - parseBaseType = do - _ <- lSymbol "spam3"; return SPAM3 - <|> do _ <- lSymbol "integer"; return Integer - <|> do _ <- lSymbol "double"; return Double - <|> do _ <- lSymbol "func_basis"; return FunctionBasis + parseArrayIndices = lParens $ lCommaSep1 parseArrayIndex + parseArrayIndex = + (lSymbol ":" >> return UnnamedIndex) + <|> (NamedIndex <$> lIdentifier) + parseBaseType = choice + [ lSymbol "spam3" >> return SPAM3 + , lSymbol "integer" >> return Integer + , lSymbol "double" >> return Double + , lSymbol "func_basis" >> return FunctionBasis + ] parsePPDFunctionSet :: OFLParser TargetType -parsePPDFunctionSet = do - _ <- lSymbol "ppd_function_set" - _ <- lSymbol "with" - properties <- lCommaSep parsePPDFunctionSetProperty - return $ PPDFunctionSet properties +parsePPDFunctionSet = + lSymbol "ppd_function_set" >> + lSymbol "with" >> + PPDFunctionSet <$> lCommaSep parsePPDFunctionSetProperty parsePPDFunctionSetProperty :: OFLParser PPDFunctionSetProperty parsePPDFunctionSetProperty = parseBasisProperty <|> parseDataProperty "PPD function set property" where - parseBasisProperty = do - _ <- lSymbol "basis" - ident <- lParens lIdentifier - return $ PPDBasis ident - parseDataProperty = do - _ <- lSymbol "data" - ident <- lParens lIdentifier - return $ PPDData ident + parseBasisProperty = lSymbol "basis" >> PPDBasis <$> lParens lIdentifier + parseDataProperty = lSymbol "data" >> PPDData <$> lParens lIdentifier runOFLParser :: String -> Either ParseError OFL runOFLParser inputString = runParser parseOFL emptyOFL "" inputString diff --git a/src/Main.hs b/src/Main.hs index 261c3e2..3053541 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,9 +6,7 @@ import OFC.TopLevel (OFL) import OFC.SecondLevel (buildSecondLevel) main :: IO() -main = do - args <- getArgs - processFile $ getFileName args +main = getArgs >>= processFile . getFileName getFileName :: [String] -> String getFileName [filename] = filename @@ -16,7 +14,7 @@ getFileName _ = error "Usage: ofc input_file" processFile :: String -> IO() processFile filename = do - contents <- readFile $ filename + contents <- readFile filename let result = runOFLParser contents in case result of Left err -> putStrLn $ show err -- 2.47.3