From 05da2cda9151375316a5aafa9b0db261ea8e405c Mon Sep 17 00:00:00 2001 From: Francis Russell Date: Wed, 12 Sep 2012 18:55:56 +0100 Subject: [PATCH] Add state to parser and detect redefined symbols. --- ofc.cabal | 2 +- src/ParsedOFL.hs | 48 ++++++++++++++++++++++++++++++ src/Parsing.hs | 77 +++++++++++++++++++++--------------------------- 3 files changed, 83 insertions(+), 44 deletions(-) create mode 100644 src/ParsedOFL.hs diff --git a/ofc.cabal b/ofc.cabal index aae9fec..950c170 100644 --- 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 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 8bc0bff..372a39c 100644 --- 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 -- 2.47.3