]> git.unchartedbackwaters.co.uk Git - francis/ofc.git/commitdiff
Clean-ups to parsing code.
authorFrancis Russell <francis@unchartedbackwaters.co.uk>
Fri, 14 Sep 2012 15:18:40 +0000 (16:18 +0100)
committerFrancis Russell <francis@unchartedbackwaters.co.uk>
Fri, 14 Sep 2012 15:18:40 +0000 (16:18 +0100)
src/ParsedOFL.hs
src/Parsing.hs

index 461e6a80b4a56e29a54de8badd323f4476436744..48ecd048c83b4cd6e0a2c090e1dbf6a6e0be85e6 100644 (file)
@@ -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] |
index 57a74d989ef260e2ec45f7be2dfe00910cf71758..9d0fb282f9ab4dad5a8b4a49fed5361f66550359 100644 (file)
@@ -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;