From 88f8b1821f09fb1b588231c8edd50b317fed932f Mon Sep 17 00:00:00 2001 From: Francis Russell Date: Fri, 14 Sep 2012 18:04:05 +0100 Subject: [PATCH] Fix most reported warnings. --- src/Main.hs | 1 - src/ParsedOFL.hs | 44 ++++++++++++++++++++++++-------------------- src/Parsing.hs | 42 ++++++++++++++++++++---------------------- 3 files changed, 44 insertions(+), 43 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index b84829e..054a36e 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,5 +1,4 @@ module Main where -import System.IO (readFile) import System.Environment (getArgs) import Parsing diff --git a/src/ParsedOFL.hs b/src/ParsedOFL.hs index e4d6ca6..27bbd2c 100644 --- a/src/ParsedOFL.hs +++ b/src/ParsedOFL.hs @@ -82,28 +82,28 @@ hasValue ofl name = case Map.lookup name (symbols ofl) of Just (ValueTag _ _) -> True _ -> False -promote :: BaseType -> BaseType -> BaseType -promote FunctionType _ = FunctionType -promote _ FunctionType = FunctionType -promote RealType _ = RealType -promote _ RealType = RealType -promote t1 t2 | (t1 == t2) = t1 +promoteType :: BaseType -> BaseType -> BaseType +promoteType FunctionType _ = FunctionType +promoteType _ FunctionType = FunctionType +promoteType RealType _ = RealType +promoteType _ RealType = RealType +promoteType IntegerType IntegerType = IntegerType getType :: OFL -> Expression -> BaseType +getType _ (ConstReal _) = RealType +getType _ (ConstInteger _) = IntegerType +getType _ (Inner _ _) = RealType +getType _ (Laplacian _) = FunctionType +getType _ (PositionComponent _) = FunctionType getType ofl (IndexedIdentifier name _) = getValueType ofl name -getType ofl (ConstReal _) = RealType -getType ofl (ConstInteger _) = IntegerType getType ofl (Negate e) = getType ofl e -getType ofl (Inner _ _) = RealType -getType ofl (Laplacian _) = FunctionType getType ofl (Sum e _) = getType ofl e -getType ofl (Multiply a b) = promote (getType ofl a) (getType ofl b) -getType ofl (Divide a b) = promote (getType ofl a) (getType ofl b) -getType ofl (Add a b) = promote (getType ofl a) (getType ofl b) -getType ofl (Sub a b) = promote (getType ofl a) (getType ofl b) -getType ofl (Power a b) = promote (getType ofl a) (getType ofl b) -getType ofl (PositionComponent _) = FunctionType -getType ofl (Derivative e i) = getType ofl e +getType ofl (Multiply a b) = promoteType (getType ofl a) (getType ofl b) +getType ofl (Divide a b) = promoteType (getType ofl a) (getType ofl b) +getType ofl (Add a b) = promoteType (getType ofl a) (getType ofl b) +getType ofl (Sub a b) = promoteType (getType ofl a) (getType ofl b) +getType ofl (Power a b) = promoteType (getType ofl a) (getType ofl b) +getType ofl (Derivative e _) = getType ofl e emptyOFL :: OFL emptyOFL = OFL { assignments = [], symbols = Map.empty } @@ -111,7 +111,11 @@ emptyOFL = OFL { assignments = [], symbols = Map.empty } -- Validation data ValidationError = Message String deriving Show type ValidationResult = Either ValidationError () + +validationSuccess :: ValidationResult validationSuccess = Right () + +validationFailure :: String -> ValidationResult validationFailure = \x -> Left (Message x) validateAssignment :: OFL -> Assignment -> ValidationResult @@ -124,7 +128,7 @@ validateAssignment ofl (Assign lhs rhs) = do False -> validationFailure $ "Types of left and right-hand sides of assignment do not match" isLValue :: OFL -> Expression -> ValidationResult -isLValue ofl (IndexedIdentifier name indices) = validationSuccess +isLValue _ (IndexedIdentifier _ _) = validationSuccess isLValue _ e = validationFailure $ "Expression " ++ show e ++ " is not an assignable value" indexExists :: OFL -> String -> ValidationResult @@ -153,9 +157,9 @@ validateExpression ofl (IndexedIdentifier name indices) = do True -> validationSuccess False -> validationFailure $ "Incorrect number or type of indices used to index " ++ name -validateExpression ofl (ConstReal _) = validationSuccess +validateExpression _ (ConstReal _) = validationSuccess -validateExpression ofl (ConstInteger _) = validationSuccess +validateExpression _ (ConstInteger _) = validationSuccess validateExpression ofl (Negate e) = validateExpression ofl e diff --git a/src/Parsing.hs b/src/Parsing.hs index 7c6750f..0fc0914 100644 --- a/src/Parsing.hs +++ b/src/Parsing.hs @@ -1,13 +1,11 @@ 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 +oflKeywords :: [String] oflKeywords = map show [minBound::IndexType ..] ++ map show [minBound::BaseType ..] ++ ["^", "+", "-", "*", "/", "laplacian", "inner", "sum", "derivative", "r", "target"] @@ -35,12 +33,12 @@ TokenParser { naturalOrFloat = lNaturalOrFloat } = makeTokenParser oflDef -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] +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 lReserved $ show t; return t | t <- [minBound::BaseType ..]] @@ -69,7 +67,7 @@ parseIdentifier = lIdentifier "identifier" parseAssignment :: Parsec String OFL () parseAssignment = do lhs <- parseExpression - lSymbol "=" + _ <- lSymbol "=" rhs <- parseExpression modifyState(\x -> addAssignment x lhs rhs) "assignment" @@ -78,9 +76,9 @@ parseExpression = buildExpressionParser oflOperatorTable parseTerm 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 "inner"; res <- lParens parseInner; return res + <|> do lReserved "sum"; res <- lParens parseSum; return res + <|> do lReserved "derivative"; res <- lParens parseDerivative; return res <|> do lReserved "r"; index <- lBrackets parseIdentifier; return $ PositionComponent index <|> do number <- lNaturalOrFloat return $ case number of @@ -92,29 +90,29 @@ parseTerm = do parseInner = do e1 <- parseExpression - lSymbol "," + _ <- lSymbol "," e2 <- parseExpression return $ Inner e1 e2 "inner product" parseSum = do e1 <- parseExpression - lSymbol "," + _ <- lSymbol "," index <- parseIdentifier return $ Sum e1 index "sum" parseDerivative = do e1 <- parseExpression - lSymbol "," + _ <- lSymbol "," index <- parseIdentifier return $ Derivative e1 index "derivative" parseIdentifierAccess = do - identifier <- parseIdentifier + ident <- parseIdentifier indices <- option [] (lBrackets $ lCommaSep parseIdentifier) - return $ IndexedIdentifier identifier indices + return $ IndexedIdentifier ident indices "indexed identifier" parseTarget = lReserved "target" >> lIdentifier @@ -122,11 +120,11 @@ parseTarget = lReserved "target" >> lIdentifier parseOFL :: Parsec String OFL OFL parseOFL = do lWhiteSpace - many1 parseDeclaration - many1 parseAssignment + _ <- many1 parseDeclaration + _ <- many1 parseAssignment target <- parseTarget - many1 anyChar + _ <- many1 anyChar eof getState -parseAsOFL string = runParser parseOFL emptyOFL "(unknown)" string +parseAsOFL inputString = runParser parseOFL emptyOFL "(unknown)" inputString -- 2.47.3