module Parsing where
import Text.Parsec
import Text.Parsec.Prim
+import Text.Parsec.Expr
import Text.Parsec.Token
import Text.Parsec.Language
import Text.Parsec.Combinator
data OFL = OFL [OFLDeclaration] deriving Show
data OFLType = Real | Function | Integer deriving Show
data OFLIndex = FunctionIndex | SpinIndex | SpatialIndex deriving Show
-data OFLDeclaration = Declaration OFLType [OFLIndex] [String] 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] deriving Show
+data OFLExpression = Identifier String |
+ IndexedIdentifier String [String] |
+ ConstReal Double |
+ ConstInteger Integer |
+ Negate OFLExpression |
+ Inner OFLExpression OFLExpression |
+ Laplacian OFLExpression |
+ Sum OFLExpression String |
+ Product OFLExpression OFLExpression |
+ Derivative OFLExpression String deriving Show
oflIndexTypes = ["FunctionIndex", "SpinIndex", "SpatialIndex"]
oflOperandTypes = ["Real", "Function", "Integer"]
, commaSep = oflCommaSep
, brackets = oflBrackets
, symbol = oflSymbol
+ , parens = oflParens
+ , float = oflFloat
+ , integer = oflInteger
} = makeTokenParser oflDef
+oflOperatorTable = [[Prefix (do { oflSymbol "-"; return (\x -> Negate x)})],
+ [Infix (do { oflSymbol "*"; return (\x y -> Product 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 = do { valueType <- parseType;
- indices <- oflBrackets $ oflCommaSep parseIndex;
- names <- oflCommaSep parseIdentifier;
- return $ Declaration valueType indices names
- }
+parseDeclaration = parseValueDeclaration <|> parseIndexDeclaration
+parseValueDeclaration = do { valueType <- parseType;
+ indices <- oflBrackets $ oflCommaSep parseIndex;
+ names <- oflCommaSep parseIdentifier;
+ return $ DeclareValues valueType indices names
+}
+
+parseIndexDeclaration = do { indexType <- parseIndex;
+ names <- oflCommaSep parseIdentifier;
+ return $ DeclareIndices indexType names
+ }
parseIdentifier = do {identifier <- oflIdentifier; return identifier }
-parseAssignment = do { lhs <- parseExpression;
+parseAssignment = do { lhs <- parseIdentifierAccess;
oflSymbol "=";
rhs <- parseExpression;
return $ Assign lhs rhs
}
-parseExpression = parseIndexedIdentifier <|> parseUnindexedIdentifier
+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} <|>
+ do { float <- oflFloat; return $ ConstReal float } <|>
+ do { integer <- oflInteger; return $ ConstInteger integer } <|>
+ oflParens parseExpression <|>
+ parseIdentifierAccess
+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
parseUnindexedIdentifier = do { identifier <- parseIdentifier;
return $ Identifier identifier