Add state to parser and detect redefined symbols.

diff --git a/ofc.cabal b/ofc.cabal
index aae9fec6a76e1ca4f4b67cd7846b7539ffe18d23..950c170fdc915a6124bcb6d4a7b2e9252ffa0329 100644 (file)
--- a/ofc.cabal
+++ b/ofc.cabal
@@ -9,4 +9,4 @@ Cabal-Version:       >=1.2
 Executable ofc
   Main-is:           Main.hs
   Hs-Source-Dirs:    src
-  Build-Depends:     base, parsec >= 3
+  Build-Depends:     base, containers, parsec >= 3

diff --git a/src/ParsedOFL.hs b/src/ParsedOFL.hs
new file mode 100644 (file)
index 0000000..fe41140
--- /dev/null
+++ b/src/ParsedOFL.hs
@@ -0,0 +1,48 @@
+module ParsedOFL where
+import Data.Map as Map
+
+-- The top-level types
+data BaseType = Real | Function | Integer deriving Show
+data IndexType = FunctionIndex | SpinIndex | SpatialIndex deriving Show
+
+-- Expressions
+data Expression = IndexedIdentifier String [String] |
+                  ConstReal Double |
+                  ConstInteger Integer |
+                  Negate Expression | 
+                  Inner Expression Expression | 
+                  Laplacian Expression | 
+                  Sum Expression String |
+                  Multiply Expression Expression |
+                  Divide Expression Expression |
+                  Power Expression Expression |
+                  Derivative Expression String deriving Show
+
+data Assignment = Assign String [String] Expression deriving Show
+
+-- The symbol table
+data SymbolType = ValueTag BaseType [IndexType] | IndexTag IndexType deriving Show
+type SymbolTable = Map String SymbolType
+data OFL = OFL {
+  symbols :: SymbolTable,
+  assignments :: [Assignment]
+} deriving Show
+
+-- Symbol table manipulators
+addValueDeclaration :: OFL -> String -> BaseType -> [IndexType] -> OFL
+addValueDeclaration ofl name baseType indices = ofl { symbols = symbols' }
+  where symbols' = insertWithKey errorOnDuplicate name (ValueTag baseType indices) (symbols ofl)
+
+addIndexDeclaration :: OFL -> String -> IndexType -> OFL
+addIndexDeclaration ofl name indexType = ofl { symbols = symbols' }
+  where symbols' = insertWithKey errorOnDuplicate name (IndexTag indexType) (symbols ofl)
+
+addAssignment :: OFL -> Expression -> Expression  -> OFL
+addAssignment ofl (IndexedIdentifier name indices) rhs = ofl { assignments = (Assign name indices rhs):(assignments ofl) } 
+addAssignment _ _ _ = error "left-hand side of assignment does not appear to be an lvalue."
+
+errorOnDuplicate :: Show k => k -> a -> a -> a
+errorOnDuplicate key _ _ = error $ "Attempted redefinition of symbol " ++ show key
+
+emptyOFL :: OFL
+emptyOFL = OFL { assignments = [], symbols = Map.empty }

diff --git a/src/Parsing.hs b/src/Parsing.hs
index 8bc0bff7837d2274f4427f5f67087259c5e15867..372a39c45c1828e8465c349f423798da6a982660 100644 (file)
--- a/src/Parsing.hs
+++ b/src/Parsing.hs
@@ -1,28 +1,13 @@
 module Parsing where
+import ParsedOFL
 import Text.Parsec
 import Text.Parsec.Prim
 import Text.Parsec.Expr
+import Text.Parsec.String
 import Text.Parsec.Token
 import Text.Parsec.Language
 import Text.Parsec.Combinator
 
-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 = IndexedIdentifier String [String] | 
-                     ConstReal Double |
-                     ConstInteger Integer |
-                     Negate OFLExpression | 
-                     Inner OFLExpression OFLExpression | 
-                     Laplacian OFLExpression | 
-                     Sum OFLExpression String |
-                     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 ++ ["*", "-", "^", "laplacian", "inner", "sum", "derivative"]
@@ -56,53 +41,59 @@ oflOperatorTable = [[Infix  (do { oflSymbol "^"; return (\x y -> Power x y) }) A
 
 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 :: Parsec String OFL ()
 parseDeclaration = parseValueDeclaration <|> parseIndexDeclaration
+
+parseValueDeclaration :: Parsec String OFL ()
 parseValueDeclaration = do { valueType <- parseType;
                              indices <- option [] (oflBrackets $ oflCommaSep parseIndex);
                              names <- oflCommaSep parseIdentifier;
-                             return $ DeclareValues valueType indices names
+                             foldl1 (>>) [modifyState(\x -> addValueDeclaration x name valueType indices) | name <- names]
 } <?> "value declaration"
 
+parseIndexDeclaration :: Parsec String OFL ()
 parseIndexDeclaration = do { indexType <- parseIndex;
                              names <- oflCommaSep parseIdentifier;
-                             return $ DeclareIndices indexType names
+                             foldl1 (>>) [modifyState(\x -> addIndexDeclaration x name indexType) | name <- names]
                            } <?> "index declaration"
 
 parseIdentifier = oflIdentifier <?> "identifier"
 
+parseAssignment :: Parsec String OFL ()
 parseAssignment = do { lhs <- parseIdentifierAccess;
-                       oflSymbol "=";
-                       rhs <- parseExpression;
-                       return $ Assign lhs rhs
-                     } <?> "assignment"
-
+                        oflSymbol "=";
+                        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 { float <- oflFloat; return $ ConstReal float } <|>
-            do { integer <- oflInteger; return $ ConstInteger integer } <|>
-            oflParens parseExpression <|>
-            parseIdentifierAccess <?>
-            "term"
-
+             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 <?>
+             "term"
+ 
 parseInner = do { e1 <- parseExpression; oflSymbol ","; e2 <- parseExpression; return $ Inner e1 e2} <?> "inner product"
-
+ 
 parseSum = do { e1 <- parseExpression; oflSymbol ","; index <- parseIdentifier; return $ Sum e1 index} <?> "sum"
 
 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
-                            } <?> "indexed identifier"
-
+                           } <?> "indexed identifier"
+ 
+parseOFL :: Parsec String OFL OFL
 parseOFL = do { oflWhiteSpace; 
-                declarations <- many1 parseDeclaration; 
-                assignments <- many1 parseAssignment;
-                return $ OFL declarations assignments
+                many1 parseDeclaration;
+                many1 parseAssignment;
+                getState
               }
-
-parseAsOFL string = parse parseOFL "(unknown)" string
+parseAsOFL string = runParser parseOFL emptyOFL "(unknown)" string