diff --git a/app/Main.hs b/app/Main.hs index b205c70..fbd5ed9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,11 +1,12 @@ module Main (main) where +import Interpreter.Interpreter import Parser.Program import Text.Parsec (parse) developProgram :: String developProgram = - "int i = 1; int j = 2; int k = i + j;" + "int i = 1; int j = 2; int l = 3 + 4; int k = i + j + l;" main :: IO () main = do @@ -15,3 +16,4 @@ main = do Right program -> do putStrLn "Parsed program:" print program + interpret program diff --git a/package.yaml b/package.yaml index 24c5ccb..1207fa9 100644 --- a/package.yaml +++ b/package.yaml @@ -21,6 +21,7 @@ dependencies: - parsec >= 3.1.16 && < 4 - prettyprinter >= 1.7.1 && < 2 - optparse-applicative >= 0.17.0 + - containers ghc-options: - -Wall diff --git a/peter.cabal b/peter.cabal index 512d1c2..45d2703 100644 --- a/peter.cabal +++ b/peter.cabal @@ -26,6 +26,7 @@ source-repository head library exposed-modules: AST + Interpreter.Interpreter Parser.Assignment Parser.Comment Parser.EndOfLine @@ -44,6 +45,7 @@ library ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5 + , containers , optparse-applicative >=0.17.0 , parsec >=3.1.16 && <4 , prettyprinter >=1.7.1 && <2 @@ -58,6 +60,7 @@ executable peter-exe ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 + , containers , optparse-applicative >=0.17.0 , parsec >=3.1.16 && <4 , peter @@ -77,6 +80,7 @@ test-suite peter-test build-depends: HUnit , base >=4.7 && <5 + , containers , optparse-applicative >=0.17.0 , parsec >=3.1.16 && <4 , peter diff --git a/src/Interpreter/Interpreter.hs b/src/Interpreter/Interpreter.hs new file mode 100644 index 0000000..a819a85 --- /dev/null +++ b/src/Interpreter/Interpreter.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE GADTs #-} + +module Interpreter.Interpreter (module Interpreter.Interpreter) where + +import AST +import Control.Monad (foldM) +import Data.Map.Strict as Map + +data Value = IntValue Int | FloatValue Float | BoolValue Bool | UnitValue + deriving (Show) + +data ProgramState where + ProgramState :: {variables :: Map Name Value} -> ProgramState + deriving (Show) + +interpret :: Program -> IO () +interpret (Program statements) = do + endState <- foldM interpretStatement (ProgramState empty) statements + putStrLn $ "End state: " ++ show endState + +interpretStatement :: ProgramState -> Statement -> IO ProgramState +interpretStatement state (VariableStatement (Variable name _ expression)) = do + value <- interpretExpression state expression + return (updateState state name value) +interpretStatement state (AssignmentStatement (Assignment name expression)) = do + value <- interpretExpression state expression + return (updateState state name value) + +updateState :: ProgramState -> Name -> Value -> ProgramState +updateState (ProgramState vars) name value = ProgramState $ Map.insert name value vars + +interpretExpression :: ProgramState -> Expression -> IO Value +interpretExpression state (AtomicExpression atomic) = do + interpretAtomic state atomic +interpretExpression state (OperationExpression left operator right) = do + leftValue <- interpretExpression state left + rightValue <- interpretExpression state right + let value = interpretOperation operator leftValue rightValue + return value + +interpretAtomic :: ProgramState -> Atomic -> IO Value +interpretAtomic _ (LiteralAtomic literal) = do + interpretLiteral literal +interpretAtomic (ProgramState vars) (VariableAtomic name) = do + let varValue = Map.lookup name vars + return $ case varValue of + Just value -> value + Nothing -> error $ "Variable not found: " ++ name + +interpretLiteral :: Literal -> IO Value +interpretLiteral (IntLiteral value) = do + return $ IntValue value +interpretLiteral (FloatLiteral value) = do + return $ FloatValue value +interpretLiteral (BoolLiteral value) = do + return $ BoolValue value +interpretLiteral UnitLiteral = do + return UnitValue + +interpretOperation :: Operator -> Value -> Value -> Value +interpretOperation Plus (IntValue left) (IntValue right) = IntValue $ left + right +interpretOperation Plus (FloatValue left) (FloatValue right) = FloatValue $ left + right +interpretOperation operator left right = error $ "Unsupported operation: " ++ show operator ++ " " ++ show left ++ " " ++ show right