From ec4adc92b25ee1d27531d2694e9a6dfb50df0d7e Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Thu, 7 Mar 2024 22:33:48 +0100 Subject: [PATCH] pass string into print function --- app/Main.hs | 2 +- peter.cabal | 1 + src/AST.hs | 6 +++--- src/Interpreter/BuiltIn.hs | 17 +++++++---------- src/Interpreter/Interpreter.hs | 19 +++++++------------ src/Interpreter/ProgramState.hs | 13 +++++++++++++ src/Parser/Atomic.hs | 26 ++++++-------------------- src/Parser/Expression.hs | 16 +++++++++++++++- src/Parser/Literal.hs | 8 ++++++++ src/Parser/Type.hs | 1 + 10 files changed, 62 insertions(+), 47 deletions(-) create mode 100644 src/Interpreter/ProgramState.hs diff --git a/app/Main.hs b/app/Main.hs index 959943c..70262a7 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -9,7 +9,7 @@ developProgram = -- "int i = 1; int j = 2; int l = 3 + 4; int k = i + j + l; k = k * 0;" -- "void test(int i, int k) { }" -- "print()" - "int main() { print(); }" + "int main() { print(\"Test\"); }" main :: IO () main = do diff --git a/peter.cabal b/peter.cabal index 04afda9..fccc156 100644 --- a/peter.cabal +++ b/peter.cabal @@ -28,6 +28,7 @@ library AST Interpreter.BuiltIn Interpreter.Interpreter + Interpreter.ProgramState Interpreter.Validator Parser.Assignment Parser.Atomic diff --git a/src/AST.hs b/src/AST.hs index ae790a8..bb3ffc8 100644 --- a/src/AST.hs +++ b/src/AST.hs @@ -5,10 +5,10 @@ type Name = String data Operator = Plus | Minus | Multiply | Divide | Modulus | And | Or | Not | Eq | Neq | Lt | Gt | Le | Ge deriving (Show, Eq) -data Literal = IntLiteral Int | FloatLiteral Float | BoolLiteral Bool | UnitLiteral +data Literal = IntLiteral Int | FloatLiteral Float | BoolLiteral Bool | UnitLiteral | StringLiteral String deriving (Show, Eq) -data Atomic = LiteralAtomic Literal | VariableAtomic Name | FunctionCallAtomic Name [Atomic] +data Atomic = LiteralAtomic Literal | VariableAtomic Name | FunctionCallAtomic Name [Expression] deriving (Show, Eq) data Expression = OperationExpression Expression Operator Expression | AtomicExpression Atomic @@ -25,7 +25,7 @@ data Assignment = Assignment Name Expression type Comment = String -data Type = IntType | FloatType | BoolType | UnitType | CustomType Name +data Type = IntType | FloatType | BoolType | UnitType | CustomType Name | StringType deriving (Show, Eq) data Statement = VariableStatement Variable | AssignmentStatement Assignment | FunctionDefinitionStatement Function | ExpressionStatement Expression diff --git a/src/Interpreter/BuiltIn.hs b/src/Interpreter/BuiltIn.hs index a75a6b9..6d160c9 100644 --- a/src/Interpreter/BuiltIn.hs +++ b/src/Interpreter/BuiltIn.hs @@ -2,13 +2,9 @@ module Interpreter.BuiltIn (module Interpreter.BuiltIn) where import AST import Data.Map.Strict as Map +import Interpreter.ProgramState --- import Text.Parsec --- import Text.Parsec.String - --- printBuiltIn :: Parser Statement - -data BuiltIn = BuiltIn Name [Type] Type ([Type] -> IO Type) +data BuiltIn = BuiltIn Name Type ([Value] -> IO Value) getAllBuiltIns :: Map String BuiltIn getAllBuiltIns = Map.fromList [("print", printBuiltIn)] @@ -17,9 +13,10 @@ printBuiltIn :: BuiltIn printBuiltIn = BuiltIn "print" - [CustomType "String"] UnitType - ( \[CustomType "String"] -> do - putStrLn "Hello, World!\n" - pure UnitType + ( \val -> do + case val of + [(StringValue s)] -> putStrLn s + _ -> error "Not a single string" + pure UnitValue ) diff --git a/src/Interpreter/Interpreter.hs b/src/Interpreter/Interpreter.hs index 9ad6f10..185bb8b 100644 --- a/src/Interpreter/Interpreter.hs +++ b/src/Interpreter/Interpreter.hs @@ -1,20 +1,12 @@ -{-# LANGUAGE GADTs #-} - module Interpreter.Interpreter (module Interpreter.Interpreter) where import AST import Control.Monad (foldM) import Data.Map.Strict as Map import Interpreter.BuiltIn +import Interpreter.ProgramState import Interpreter.Validator -data Value = IntValue Int | FloatValue Float | BoolValue Bool | UnitValue - deriving (Show) - -data ProgramState where - ProgramState :: {variables :: Map Name Value, functions :: Map Name Statement} -> ProgramState - deriving (Show) - interpret :: Program -> IO () interpret (Program statements) = do isValid <- validate (Program statements) @@ -69,11 +61,12 @@ interpretAtomic (ProgramState vars _) (VariableAtomic name) = do return $ case varValue of Just value -> value Nothing -> error $ "Variable not found: " ++ name -interpretAtomic (ProgramState vars funs) (FunctionCallAtomic name _args) = do +interpretAtomic (ProgramState vars funs) (FunctionCallAtomic name args) = do let isBuiltIn = Map.lookup name getAllBuiltIns case isBuiltIn of - Just (BuiltIn _ args outputType fn) -> do - _ <- fn args + Just (BuiltIn _ outputType fn) -> do + argValues <- mapM (\a -> interpretExpression (ProgramState vars funs) a) args + _ <- fn argValues return UnitValue Nothing -> do let fun = Map.lookup name funs @@ -92,6 +85,8 @@ interpretLiteral (BoolLiteral value) = do return $ BoolValue value interpretLiteral UnitLiteral = do return UnitValue +interpretLiteral (StringLiteral value) = do + return $ StringValue value interpretOperation :: Operator -> Value -> Value -> Value interpretOperation Plus (IntValue left) (IntValue right) = IntValue $ left + right diff --git a/src/Interpreter/ProgramState.hs b/src/Interpreter/ProgramState.hs new file mode 100644 index 0000000..0f25150 --- /dev/null +++ b/src/Interpreter/ProgramState.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE GADTs #-} + +module Interpreter.ProgramState (module Interpreter.ProgramState) where + +import AST +import Data.Map.Strict as Map + +data Value = IntValue Int | FloatValue Float | BoolValue Bool | UnitValue | StringValue String + deriving (Show) + +data ProgramState where + ProgramState :: {variables :: Map Name Value, functions :: Map Name Statement} -> ProgramState + deriving (Show) diff --git a/src/Parser/Atomic.hs b/src/Parser/Atomic.hs index 7fb0a9f..5dacf80 100644 --- a/src/Parser/Atomic.hs +++ b/src/Parser/Atomic.hs @@ -1,22 +1,8 @@ module Parser.Atomic (module Parser.Atomic) where -import AST -import Parser.Literal (parseLiteral) -import Parser.Space -import Parser.Type -import Text.Parsec -import Text.Parsec.String - -parseAtomic :: Parser Atomic -parseAtomic = - (LiteralAtomic <$> try parseLiteral) - <|> try parseFunctionCallAtomic - <|> (VariableAtomic <$> try parseVariableName) - -parseFunctionCallAtomic :: Parser Atomic -parseFunctionCallAtomic = do - name <- try parseVariableName - _ <- char '(' - args <- try (parseAtomic `sepBy` (spaces' >> char ',' >> spaces')) - _ <- char ')' - return $ FunctionCallAtomic name args +-- import AST +-- import Parser.Literal (parseLiteral) +-- import Parser.Space +-- import Parser.Type +-- import Text.Parsec +-- import Text.Parsec.String diff --git a/src/Parser/Expression.hs b/src/Parser/Expression.hs index 4281820..055b29a 100644 --- a/src/Parser/Expression.hs +++ b/src/Parser/Expression.hs @@ -1,7 +1,7 @@ module Parser.Expression (module Parser.Expression) where import AST -import Parser.Atomic +-- import Parser.Atomic import Parser.Literal (parseLiteral) import Parser.Operator (parseOperator) import Parser.Space @@ -26,3 +26,17 @@ parseOperation = parseAtomicExpression :: Parser Expression parseAtomicExpression = do AtomicExpression <$> try parseAtomic + +parseFunctionCallAtomic :: Parser Atomic +parseFunctionCallAtomic = do + name <- try parseVariableName + _ <- char '(' + args <- try (parseExpression `sepBy` (spaces' >> char ',' >> spaces')) + _ <- char ')' + return $ FunctionCallAtomic name args + +parseAtomic :: Parser Atomic +parseAtomic = + (LiteralAtomic <$> try parseLiteral) + <|> try parseFunctionCallAtomic + <|> (VariableAtomic <$> try parseVariableName) diff --git a/src/Parser/Literal.hs b/src/Parser/Literal.hs index c94524d..9017e52 100644 --- a/src/Parser/Literal.hs +++ b/src/Parser/Literal.hs @@ -10,6 +10,7 @@ parseLiteral = <|> try parseBoolLiteral <|> try parseFloatLiteral <|> try parseIntLiteral + <|> try praseStringLiteral parseIntLiteral :: Parser Literal parseIntLiteral = do @@ -36,3 +37,10 @@ parseBoolLiteral = parseUnitLiteral :: Parser Literal parseUnitLiteral = string "()" >> return UnitLiteral + +praseStringLiteral :: Parser Literal +praseStringLiteral = do + _ <- char '"' + s <- many (noneOf "\"") + _ <- char '"' + return $ StringLiteral s diff --git a/src/Parser/Type.hs b/src/Parser/Type.hs index 5f0da7f..5126c68 100644 --- a/src/Parser/Type.hs +++ b/src/Parser/Type.hs @@ -10,6 +10,7 @@ parseType = <|> (string "int" >> return IntType) <|> (string "float" >> return FloatType) <|> (string "bool" >> return BoolType) + <|> (string "str" >> return StringType) <|> (CustomType <$> parseVariableName) parseVariableName :: Parser Name