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 {
} = 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 ..]
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
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
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
<?> "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 ()
_ <- 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
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 =
<|> 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
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
projects / francis / ofc.git / commitdiff