From 19455bdd0b8934824afd96e81ec600ac89e79098 Mon Sep 17 00:00:00 2001 From: Francis Russell Date: Fri, 14 Sep 2012 16:18:40 +0100 Subject: [PATCH] Clean-ups to parsing code. --- src/ParsedOFL.hs | 4 +-- src/Parsing.hs | 75 ++++++++++++++++++++++++------------------------ 2 files changed, 39 insertions(+), 40 deletions(-) diff --git a/src/ParsedOFL.hs b/src/ParsedOFL.hs index 461e6a8..48ecd04 100644 --- a/src/ParsedOFL.hs +++ b/src/ParsedOFL.hs @@ -2,8 +2,8 @@ module ParsedOFL where import Data.Map as Map (Map, lookup, insertWithKey, empty) -- The top-level types -data BaseType = Real | Function | Integer deriving (Show, Eq) -data IndexType = FunctionIndex | SpinIndex | SpatialIndex deriving (Show, Eq) +data BaseType = Real | Function | Integer deriving (Show, Eq, Enum, Bounded) +data IndexType = FunctionIndex | SpinIndex | SpatialIndex deriving (Show, Eq, Enum, Bounded) -- Expressions data Expression = IndexedIdentifier String [String] | diff --git a/src/Parsing.hs b/src/Parsing.hs index 57a74d9..9d0fb28 100644 --- a/src/Parsing.hs +++ b/src/Parsing.hs @@ -8,10 +8,8 @@ import Text.Parsec.Token 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 = "" @@ -24,83 +22,84 @@ 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; -- 2.47.3