import Text.Parsec.Language
import Text.Parsec.Combinator
-oflIndexTypes = ["FunctionIndex", "SpinIndex", "SpatialIndex"]
-oflOperandTypes = ["Real", "Function", "Integer"]
-oflKeywords = oflIndexTypes ++
- oflOperandTypes ++
+oflKeywords = map show [minBound::IndexType ..] ++
+ map show [minBound::BaseType ..] ++
["^", "+", "-", "*", "/", "laplacian", "inner", "sum", "derivative", "r", "target"]
oflDef = emptyDef{ commentStart = ""
, reservedNames = oflKeywords
}
-TokenParser { reserved = oflReserved
- , whiteSpace = oflWhiteSpace
- , identifier = oflIdentifier
- , commaSep = oflCommaSep
- , brackets = oflBrackets
- , symbol = oflSymbol
- , parens = oflParens
- , naturalOrFloat = oflNaturalOrFloat
+TokenParser { reserved = lReserved
+ , whiteSpace = lWhiteSpace
+ , identifier = lIdentifier
+ , commaSep = lCommaSep
+ , commaSep1 = lCommaSep1
+ , brackets = lBrackets
+ , symbol = lSymbol
+ , parens = lParens
+ , naturalOrFloat = lNaturalOrFloat
} = makeTokenParser oflDef
-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],
- [Infix (do { oflSymbol "+"; return (\x y -> Add x y) }) AssocLeft
- ,Infix (do { oflSymbol "-"; return (\x y -> Sub x y) }) AssocLeft]
+oflOperatorTable = [[Infix (do { lSymbol "^"; return (\x y -> Power x y) }) AssocLeft],
+ [Prefix (do { lSymbol "-"; return (\x -> Negate x)})],
+ [Infix (do { lSymbol "*"; return (\x y -> Multiply x y) }) AssocLeft
+ ,Infix (do { lSymbol "/"; return (\x y -> Divide x y) }) AssocLeft],
+ [Infix (do { lSymbol "+"; return (\x y -> Add x y) }) AssocLeft
+ ,Infix (do { lSymbol "-"; return (\x y -> Sub 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]]
+parseType = foldl1 (<|>) [do { lReserved $ show t; return t} | t <- [minBound::BaseType .. ]]
+parseIndex = foldl1 (<|>) [do { lReserved $ show t; return t} | t <- [minBound::IndexType .. ]]
parseDeclaration :: Parsec String OFL ()
parseDeclaration = parseValueDeclaration <|> parseIndexDeclaration
parseValueDeclaration :: Parsec String OFL ()
parseValueDeclaration = do { valueType <- parseType;
- indices <- option [] (oflBrackets $ oflCommaSep parseIndex);
- names <- oflCommaSep parseIdentifier;
+ indices <- option [] (lBrackets $ lCommaSep parseIndex);
+ names <- lCommaSep1 parseIdentifier;
foldl1 (>>) [modifyState(\x -> addValueDeclaration x name valueType indices) | name <- names]
} <?> "value declaration"
parseIndexDeclaration :: Parsec String OFL ()
parseIndexDeclaration = do { indexType <- parseIndex;
- names <- oflCommaSep parseIdentifier;
+ names <- lCommaSep1 parseIdentifier;
foldl1 (>>) [modifyState(\x -> addIndexDeclaration x name indexType) | name <- names]
} <?> "index declaration"
-parseIdentifier = oflIdentifier <?> "identifier"
+parseIdentifier = lIdentifier <?> "identifier"
parseAssignment :: Parsec String OFL ()
parseAssignment = do { lhs <- parseExpression;
- oflSymbol "=";
+ lSymbol "=";
rhs <- parseExpression;
modifyState(\x -> addAssignment x lhs rhs)
} <?> "assignment"
parseExpression = buildExpressionParser oflOperatorTable parseTerm
-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 { oflReserved "r"; index <- oflBrackets parseIdentifier; return $ PositionComponent index} <|>
- do { number <- oflNaturalOrFloat;
+parseTerm = do { lReserved "laplacian"; operand <- lParens parseExpression; return $ Laplacian operand } <|>
+ do { lReserved "inner"; inner <- lParens parseInner; return inner} <|>
+ do { lReserved "sum"; sum <- lParens parseSum; return sum} <|>
+ do { lReserved "derivative"; derivative <- lParens parseDerivative; return derivative} <|>
+ do { lReserved "r"; index <- lBrackets parseIdentifier; return $ PositionComponent index} <|>
+ do { number <- lNaturalOrFloat;
return $ case number of
Left i -> ConstInteger i
Right r -> ConstReal r
} <|>
- oflParens parseExpression <|>
+ lParens parseExpression <|>
parseIdentifierAccess <?>
"term"
-parseInner = do { e1 <- parseExpression; oflSymbol ","; e2 <- parseExpression; return $ Inner e1 e2} <?> "inner product"
+parseInner = do { e1 <- parseExpression; lSymbol ","; e2 <- parseExpression; return $ Inner e1 e2} <?> "inner product"
-parseSum = do { e1 <- parseExpression; oflSymbol ","; index <- parseIdentifier; return $ Sum e1 index} <?> "sum"
+parseSum = do { e1 <- parseExpression; lSymbol ","; index <- parseIdentifier; return $ Sum e1 index} <?> "sum"
-parseDerivative = do { e1 <- parseExpression; oflSymbol ","; index <- parseIdentifier; return $ Derivative e1 index} <?> "derivative"
+parseDerivative = do { e1 <- parseExpression; lSymbol ","; index <- parseIdentifier; return $ Derivative e1 index} <?> "derivative"
parseIdentifierAccess = do { identifier <- parseIdentifier;
- indices <- option [] (oflBrackets $ oflCommaSep parseIdentifier);
+ indices <- option [] (lBrackets $ lCommaSep parseIdentifier);
return $ IndexedIdentifier identifier indices
} <?> "indexed identifier"
-parseTarget = oflReserved "target" >> oflIdentifier
+parseTarget = lReserved "target" >> lIdentifier
parseOFL :: Parsec String OFL OFL
-parseOFL = do { oflWhiteSpace;
+parseOFL = do { lWhiteSpace;
many1 parseDeclaration;
many1 parseAssignment;
target <- parseTarget;