From e2d4b76c0bbad6c0740f5322e862a02971802e87 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Thu, 31 Oct 2024 22:19:48 +0100 Subject: [PATCH] Check argument list length --- TODO | 11 +-- lib/Language/Elna/Frontend/TypeAnalysis.hs | 93 +++++++++++++--------- src/Main.hs | 48 +++++++---- 3 files changed, 87 insertions(+), 65 deletions(-) diff --git a/TODO b/TODO index 1cca7c0..ec3d028 100644 --- a/TODO +++ b/TODO @@ -10,17 +10,8 @@ - Don't ignore relocations where the symbol is not defined in the symbol table. Report an error about an undefined symbol. -# Name analysis - -- Format error messages. -- Return non-zero error code on errors. - # Register allocation -- Each temporary variales gets a tn register where n is the variable index. If +- Each temporary variable gets a tn register where n is the variable index. If there more variables the allocation will fail with out of bounds runtime error. Implement spill over. - -# Other - -- Type analysis. diff --git a/lib/Language/Elna/Frontend/TypeAnalysis.hs b/lib/Language/Elna/Frontend/TypeAnalysis.hs index 7d0b050..2ddbd1c 100644 --- a/lib/Language/Elna/Frontend/TypeAnalysis.hs +++ b/lib/Language/Elna/Frontend/TypeAnalysis.hs @@ -3,42 +3,61 @@ module Language.Elna.Frontend.TypeAnalysis , -- Error(..) ) where +import Control.Monad (unless) +import Control.Monad.Trans.Class (MonadTrans(..)) +import Control.Monad.Trans.Except (Except, runExcept, throwE) +import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT, ask) +import Data.Foldable (traverse_) +import qualified Data.Vector as Vector import qualified Language.Elna.Frontend.AST as AST -import Language.Elna.Frontend.SymbolTable ({-Info(..), ParameterInfo(..), -}SymbolTable) +import Language.Elna.Frontend.SymbolTable (Info(..), {-ParameterInfo(..), -}SymbolTable) +import qualified Language.Elna.Frontend.SymbolTable as SymbolTable +import Language.Elna.Frontend.Types (Type(..), booleanType, intType) +import Language.Elna.Location (Identifier(..)) -typeAnalysis :: SymbolTable -> AST.Program -> () -- Maybe Error -typeAnalysis _globalTable = const () {- either Just (const Nothing) +typeAnalysis :: SymbolTable -> AST.Program -> Maybe Error +typeAnalysis globalTable = either Just (const Nothing) . runExcept . flip runReaderT globalTable . runTypeAnalysis - . program -} + . program {- import Control.Applicative (Alternative(..)) -import Control.Monad.Trans.Except (Except, runExcept, throwE) -import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT, withReaderT, ask) -import qualified Data.Vector as Vector -import Language.Elna.Location (Identifier(..)) -import qualified Language.Elna.SymbolTable as SymbolTable -import Language.Elna.Types (Type(..), booleanType, intType) -import Control.Monad.Trans.Class (MonadTrans(..)) -import Control.Monad (unless, when) -import Data.Foldable (traverse_) - +-} data Error - = ArithmeticExpressionError Type - | ComparisonExpressionError Type Type - | UnexpectedVariableInfoError Info - | UnexpectedProcedureInfoError Info + = UnexpectedProcedureInfoError Info | UndefinedSymbolError Identifier - | InvalidConditionTypeError Type - | InvalidAssignmentError Type - | ExpectedLvalueError AST.Expression | ParameterCountMismatchError Int Int + | UnexpectedVariableInfoError Info + | ArithmeticExpressionError Type + | ComparisonExpressionError Type Type + | InvalidConditionTypeError Type +{- | InvalidAssignmentError Type + | ExpectedLvalueError AST.Expression | ArgumentTypeMismatchError Type Type | ArrayIndexError Type - | ArrayAccessError Type - deriving (Eq, Show) + | ArrayAccessError Type -} + deriving Eq + +instance Show Error + where + show (UnexpectedProcedureInfoError info) = + "Expected to encounter a procedure, got: " <> show info + show (UndefinedSymbolError identifier) = + concat ["Symbol \"", show identifier, "\" is not defined"] + show (ParameterCountMismatchError parameterCount argumentCount) + = "The function was expected to receive " <> show argumentCount + <> " arguments, but got " <> show parameterCount + show (UnexpectedVariableInfoError info) = + "Expected to encounter a variable, got: " <> show info + show (ArithmeticExpressionError got) = + "Expected an arithmetic expression to be an integer, got: " <> show got + show (ComparisonExpressionError lhs rhs) + = "Expected an arithmetic expression to be an integer, got \"" + <> show lhs <> "\" and \"" <> show rhs <> "\"" + show (InvalidConditionTypeError got) = + "Expected a condition to be a boolean, got: " <> show got newtype TypeAnalysis a = TypeAnalysis { runTypeAnalysis :: ReaderT SymbolTable (Except Error) a @@ -61,7 +80,7 @@ program :: AST.Program -> TypeAnalysis () program (AST.Program declarations) = traverse_ declaration declarations declaration :: AST.Declaration -> TypeAnalysis () -declaration (AST.ProcedureDefinition procedureName _ _ body) = do +declaration (AST.ProcedureDeclaration procedureName _ _ body) = do globalTable <- TypeAnalysis ask case SymbolTable.lookup procedureName globalTable of Just (ProcedureInfo localTable _) -> TypeAnalysis @@ -72,29 +91,29 @@ declaration (AST.ProcedureDefinition procedureName _ _ body) = do $ UnexpectedProcedureInfoError anotherInfo Nothing -> TypeAnalysis $ lift $ throwE $ UndefinedSymbolError procedureName -declaration _ = pure () +declaration (AST.TypeDefinition _ _) = pure () statement :: SymbolTable -> AST.Statement -> TypeAnalysis () statement globalTable = \case AST.EmptyStatement -> pure () - AST.AssignmentStatement lhs rhs -> do + {- AST.AssignmentStatement lhs rhs -> do lhsType <- variableAccess globalTable lhs rhsType <- expression globalTable rhs unless (lhsType == intType) $ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError lhsType unless (rhsType == intType) $ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError rhsType + AST.WhileStatement whileCondition whileStatement -> do + conditionType <- condition globalTable whileCondition + unless (conditionType == booleanType) + $ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError conditionType + statement globalTable whileStatement -} AST.IfStatement ifCondition ifStatement elseStatement -> do conditionType <- condition globalTable ifCondition unless (conditionType == booleanType) $ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError conditionType statement globalTable ifStatement maybe (pure ()) (statement globalTable) elseStatement - AST.WhileStatement whileCondition whileStatement -> do - conditionType <- condition globalTable whileCondition - unless (conditionType == booleanType) - $ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError conditionType - statement globalTable whileStatement AST.CompoundStatement statements -> traverse_ (statement globalTable) statements AST.CallStatement procedureName arguments -> case SymbolTable.lookup procedureName globalTable of @@ -110,7 +129,7 @@ statement globalTable = \case Nothing -> TypeAnalysis $ lift $ throwE $ UndefinedSymbolError procedureName where - checkArgument ParameterInfo{..} argument = do + checkArgument SymbolTable.ParameterInfo{} _argument = pure () {- argumentType <- expression globalTable argument unless (argumentType == type') $ TypeAnalysis $ lift $ throwE $ ArgumentTypeMismatchError type' argumentType @@ -137,11 +156,11 @@ variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression) = d ArrayType _ baseType -> pure baseType nonArrayType -> TypeAnalysis $ lift $ throwE $ ArrayAccessError nonArrayType - +-} expression :: SymbolTable -> AST.Expression -> TypeAnalysis Type expression globalTable = \case - AST.VariableExpression variableExpression -> do - variableAccess globalTable variableExpression + {- AST.VariableExpression variableExpression -> do + variableAccess globalTable variableExpression -} AST.LiteralExpression literal' -> literal literal' AST.NegationExpression negation -> do operandType <- expression globalTable negation @@ -179,8 +198,6 @@ condition globalTable = \case else TypeAnalysis $ lift $ throwE $ ComparisonExpressionError lhsType rhsType literal :: AST.Literal -> TypeAnalysis Type -literal (AST.IntegerLiteral _) = pure intType +literal (AST.DecimalLiteral _) = pure intType literal (AST.HexadecimalLiteral _) = pure intType literal (AST.CharacterLiteral _) = pure intType -literal (AST.BooleanLiteral _) = pure booleanType --} diff --git a/src/Main.hs b/src/Main.hs index 2e02955..81e5976 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -15,25 +15,39 @@ import Data.Maybe (fromMaybe) import System.FilePath (replaceExtension, takeFileName) import Text.Megaparsec (runParser, errorBundlePretty) import qualified Data.Text.IO as Text +import System.Exit (ExitCode(..), exitWith) +import Control.Exception (IOException, catch) + +-- * Error codes +-- +-- 1 - Command line parsing failed and other errors. +-- 2 - The input could not be read. +-- 3 - Parse error. +-- 4 - Name analysis error. +-- 5 - Type error. main :: IO () -main = execParser commandLine >>= withCommandLine +main = execParser commandLine >>= withCommandLine where withCommandLine CommandLine{..} = - let defaultOutput = flip fromMaybe output - $ replaceExtension (takeFileName input) "o" - in Text.readFile input - >>= withParsedInput defaultOutput + let defaultOutputName = replaceExtension (takeFileName input) "o" + outputName = fromMaybe defaultOutputName output + in catch (Text.readFile input) (printAndExit 2 :: IOException -> IO a) + >>= withParsedInput outputName . runParser programP input - withParsedInput output (Right program) = - either print (withSymbolTable output program) - $ nameAnalysis program - withParsedInput _ (Left errorBundle) = putStrLn - $ errorBundlePretty errorBundle - withSymbolTable output program symbolTable = - let _ = typeAnalysis symbolTable program - instructions = generateRiscV - $ allocate riscVConfiguration - $ glue symbolTable program - in elfObject output - $ riscv32Elf instructions + withParsedInput output (Right program) + = either (printAndExit 4) (withSymbolTable output program) + $ nameAnalysis program + withParsedInput _ (Left errorBundle) + = putStrLn (errorBundlePretty errorBundle) + >> exitWith (ExitFailure 3) + withSymbolTable output program symbolTable + | Just typeError <- typeAnalysis symbolTable program = + printAndExit 5 typeError + | otherwise = + let instructions = generateRiscV + $ allocate riscVConfiguration + $ glue symbolTable program + in elfObject output $ riscv32Elf instructions + printAndExit :: Show b => forall a. Int -> b -> IO a + printAndExit failureCode e = print e >> exitWith (ExitFailure failureCode)