From 4018c8fa263cf9bfc39c162ce61454f83f2aa021 Mon Sep 17 00:00:00 2001 From: Francis Russell Date: Wed, 12 Sep 2012 15:24:56 +0100 Subject: [PATCH] Correctly parse assignments in all examples. --- src/Main.hs | 6 ++++- src/Parsing.hs | 70 +++++++++++++++++++++++++++----------------------- 2 files changed, 43 insertions(+), 33 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 6f11f2d..16583fe 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -14,4 +14,8 @@ getFileName [filename] = filename getFileName _ = error "Usage: ofc input_file" processOFL :: String -> IO() -processOFL input = putStrLn $ show $ parseOFL input +processOFL input = let result = parseAsOFL input in + do { case result of + Left err -> putStrLn $ show err + Right ofl -> putStrLn $ show ofl + } diff --git a/src/Parsing.hs b/src/Parsing.hs index e431a23..8bc0bff 100644 --- a/src/Parsing.hs +++ b/src/Parsing.hs @@ -6,33 +6,33 @@ import Text.Parsec.Token import Text.Parsec.Language import Text.Parsec.Combinator -data OFL = OFL [OFLDeclaration] deriving Show +data OFL = OFL [OFLDeclaration] [OFLAssignment] deriving Show data OFLType = Real | Function | Integer deriving Show data OFLIndex = FunctionIndex | SpinIndex | SpatialIndex deriving Show data OFLDeclaration = DeclareValues OFLType [OFLIndex] [String] | DeclareIndices OFLIndex [String] deriving Show data OFLAssignment = Assign OFLExpression OFLExpression deriving Show -data OFLExpression = Identifier String | - IndexedIdentifier String [String] | +data OFLExpression = IndexedIdentifier String [String] | ConstReal Double | ConstInteger Integer | Negate OFLExpression | Inner OFLExpression OFLExpression | Laplacian OFLExpression | Sum OFLExpression String | - Product OFLExpression OFLExpression | + Multiply OFLExpression OFLExpression | + Divide OFLExpression OFLExpression | + Power OFLExpression OFLExpression | Derivative OFLExpression String deriving Show oflIndexTypes = ["FunctionIndex", "SpinIndex", "SpatialIndex"] oflOperandTypes = ["Real", "Function", "Integer"] -oflKeywords = oflIndexTypes ++ oflOperandTypes - +oflKeywords = oflIndexTypes ++ oflOperandTypes ++ ["*", "-", "^", "laplacian", "inner", "sum", "derivative"] oflDef = emptyDef{ commentStart = "" , commentEnd = "" , commentLine = "#" , nestedComments = False - , identStart = letter - , identLetter = alphaNum <|> oneOf "_" + , identStart = letter <|> char '_' + , identLetter = alphaNum <|> char '_' , caseSensitive = True , reservedNames = oflKeywords } @@ -48,55 +48,61 @@ TokenParser { reserved = oflReserved , integer = oflInteger } = makeTokenParser oflDef -oflOperatorTable = [[Prefix (do { oflSymbol "-"; return (\x -> Negate x)})], - [Infix (do { oflSymbol "*"; return (\x y -> Product x y) }) AssocLeft] +oflOperatorTable = [[Infix (do { oflSymbol "^"; return (\x y -> Power x y) }) AssocLeft], + [Prefix (do { oflSymbol "-"; return (\x -> Negate x)})], + [Infix (do { oflSymbol "*"; return (\x y -> Multiply x y) }) AssocLeft + ,Infix (do { oflSymbol "/"; return (\x y -> Divide x y) }) AssocLeft] ] parseType = foldl1 (<|>) [do { oflReserved $ show t; return t} | t <- [Real, Function, Integer]] parseIndex = foldl1 (<|>) [do { oflReserved $ show t; return t} | t <- [FunctionIndex, SpinIndex, SpatialIndex]] parseDeclaration = parseValueDeclaration <|> parseIndexDeclaration parseValueDeclaration = do { valueType <- parseType; - indices <- oflBrackets $ oflCommaSep parseIndex; + indices <- option [] (oflBrackets $ oflCommaSep parseIndex); names <- oflCommaSep parseIdentifier; return $ DeclareValues valueType indices names -} +} "value declaration" parseIndexDeclaration = do { indexType <- parseIndex; names <- oflCommaSep parseIdentifier; return $ DeclareIndices indexType names - } + } "index declaration" -parseIdentifier = do {identifier <- oflIdentifier; return identifier } +parseIdentifier = oflIdentifier "identifier" parseAssignment = do { lhs <- parseIdentifierAccess; oflSymbol "="; rhs <- parseExpression; return $ Assign lhs rhs - } + } "assignment" parseExpression = buildExpressionParser oflOperatorTable parseTerm -parseTerm = do { oflSymbol "laplacian"; operand <- oflParens parseExpression; return $ Laplacian operand } <|> - do { oflSymbol "inner"; inner <- oflParens parseInner; return inner} <|> - do { oflSymbol "sum"; sum <- oflParens parseSum; return sum} <|> - do { oflSymbol "derivative"; derivative <- oflParens parseDerivative; return derivative} <|> +parseTerm = do { oflReserved "laplacian"; operand <- oflParens parseExpression; return $ Laplacian operand } <|> + do { oflReserved "inner"; inner <- oflParens parseInner; return inner} <|> + do { oflReserved "sum"; sum <- oflParens parseSum; return sum} <|> + do { oflReserved "derivative"; derivative <- oflParens parseDerivative; return derivative} <|> do { float <- oflFloat; return $ ConstReal float } <|> do { integer <- oflInteger; return $ ConstInteger integer } <|> oflParens parseExpression <|> - parseIdentifierAccess + parseIdentifierAccess + "term" -parseInner = do { e1 <- parseExpression; oflSymbol ","; e2 <- parseExpression; return $ Inner e1 e2} -parseSum = do { e1 <- parseExpression; oflSymbol ","; index <- parseIdentifier; return $ Sum e1 index} -parseDerivative = do { e1 <- parseExpression; oflSymbol ","; index <- parseIdentifier; return $ Derivative e1 index} - -parseIdentifierAccess = parseIndexedIdentifier <|> parseUnindexedIdentifier +parseInner = do { e1 <- parseExpression; oflSymbol ","; e2 <- parseExpression; return $ Inner e1 e2} "inner product" -parseUnindexedIdentifier = do { identifier <- parseIdentifier; - return $ Identifier identifier - } +parseSum = do { e1 <- parseExpression; oflSymbol ","; index <- parseIdentifier; return $ Sum e1 index} "sum" -parseIndexedIdentifier = do { identifier <- parseIdentifier; - indices <- oflBrackets $ oflCommaSep parseIdentifier; +parseDerivative = do { e1 <- parseExpression; oflSymbol ","; index <- parseIdentifier; return $ Derivative e1 index} "derivative" + +parseIdentifierAccess = do { identifier <- parseIdentifier; + indices <- option [] (oflBrackets $ oflCommaSep parseIdentifier); return $ IndexedIdentifier identifier indices - } -parseOFL string = parse (oflWhiteSpace >> many1 parseDeclaration >> many1 parseAssignment) "(unknown)" string + } "indexed identifier" + +parseOFL = do { oflWhiteSpace; + declarations <- many1 parseDeclaration; + assignments <- many1 parseAssignment; + return $ OFL declarations assignments + } + +parseAsOFL string = parse parseOFL "(unknown)" string -- 2.47.3