From f19766a686764c8a592ecb97ece32aef78e5aef6 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Thu, 7 Mar 2024 04:13:11 +0100 Subject: [PATCH] add basic builtin function --- app/Main.hs | 3 ++- peter.cabal | 2 ++ src/Interpreter/BuiltIn.hs | 25 +++++++++++++++++++++++++ src/Interpreter/Interpreter.hs | 19 +++++++++++++------ src/Interpreter/Validator.hs | 2 ++ src/Parser/Atomic.hs | 12 +++++------- src/Parser/Expression.hs | 8 ++++---- src/Parser/Statement.hs | 2 ++ test/Spec.hs | 2 ++ test/Unit/Parser/Atomic.hs | 30 ++++++++++++++++++++++++++++++ test/Unit/Parser/Expression.hs | 4 ++++ test/Unit/Parser/Program.hs | 16 ++++++++++++---- test/Unit/Parser/Statement.hs | 16 ++++++++++------ 13 files changed, 113 insertions(+), 28 deletions(-) create mode 100644 src/Interpreter/BuiltIn.hs create mode 100644 test/Unit/Parser/Atomic.hs diff --git a/app/Main.hs b/app/Main.hs index 39f1261..351592f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,7 +8,8 @@ developProgram :: String 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) { }" - "int main() { int i = 1; int k = i + 1; }" + -- "int main() { print(); }" + "print()" main :: IO () main = do diff --git a/peter.cabal b/peter.cabal index 8c3e6cf..04afda9 100644 --- a/peter.cabal +++ b/peter.cabal @@ -26,6 +26,7 @@ source-repository head library exposed-modules: AST + Interpreter.BuiltIn Interpreter.Interpreter Interpreter.Validator Parser.Assignment @@ -75,6 +76,7 @@ test-suite peter-test other-modules: E2E.Placeholder Unit.Parser.Assignment + Unit.Parser.Atomic Unit.Parser.Comment Unit.Parser.Expression Unit.Parser.Program diff --git a/src/Interpreter/BuiltIn.hs b/src/Interpreter/BuiltIn.hs new file mode 100644 index 0000000..4290cab --- /dev/null +++ b/src/Interpreter/BuiltIn.hs @@ -0,0 +1,25 @@ +module Interpreter.BuiltIn (module Interpreter.BuiltIn) where + +import AST +import Data.Map.Strict as Map + +-- import Text.Parsec +-- import Text.Parsec.String + +-- printBuiltIn :: Parser Statement + +data BuiltIn = BuiltIn Name [Type] Type ([Type] -> IO Type) + +getAllBuiltIns :: Map String BuiltIn +getAllBuiltIns = Map.fromList [("print", printBuiltIn)] + +printBuiltIn :: BuiltIn +printBuiltIn = + BuiltIn + "print" + [CustomType "String"] + UnitType + ( \[CustomType "String"] -> do + putStrLn "Hello, World!" + pure UnitType + ) diff --git a/src/Interpreter/Interpreter.hs b/src/Interpreter/Interpreter.hs index 1b66ba3..f06487c 100644 --- a/src/Interpreter/Interpreter.hs +++ b/src/Interpreter/Interpreter.hs @@ -5,6 +5,7 @@ module Interpreter.Interpreter (module Interpreter.Interpreter) where import AST import Control.Monad (foldM) import Data.Map.Strict as Map +import Interpreter.BuiltIn import Interpreter.Validator data Value = IntValue Int | FloatValue Float | BoolValue Bool | UnitValue @@ -67,12 +68,18 @@ interpretAtomic (ProgramState vars _) (VariableAtomic name) = do Just value -> value Nothing -> error $ "Variable not found: " ++ name interpretAtomic (ProgramState vars funs) (FunctionCallAtomic name _args) = do - let fun = Map.lookup name funs - case fun of - Just (FunctionDefinitionStatement (Function _ _ _ body)) -> do - _ <- foldM interpretStatement (ProgramState vars funs) body - return UnitValue -- TODO: add return values - Nothing -> error $ "Function not found: " ++ name + let isBuiltIn = Map.lookup name getAllBuiltIns + case isBuiltIn of + Just (BuiltIn _ args outputType fn) -> do + _ <- fn args + return UnitValue + Nothing -> do + let fun = Map.lookup name funs + case fun of + Just (FunctionDefinitionStatement (Function _ _ _ body)) -> do + _ <- foldM interpretStatement (ProgramState vars funs) body + return UnitValue -- TODO: add return values + Nothing -> error $ "Function not found: " ++ name interpretLiteral :: Literal -> IO Value interpretLiteral (IntLiteral value) = do diff --git a/src/Interpreter/Validator.hs b/src/Interpreter/Validator.hs index 3194683..2d685d0 100644 --- a/src/Interpreter/Validator.hs +++ b/src/Interpreter/Validator.hs @@ -32,3 +32,5 @@ hasEntryPoint (Program statements) = isGlobalStatement (AssignmentStatement _) = True isGlobalStatement (ExpressionStatement _) = True isGlobalStatement _ = False + +-- TODO: check no name clash with built-in functions diff --git a/src/Parser/Atomic.hs b/src/Parser/Atomic.hs index fb7a32a..7fb0a9f 100644 --- a/src/Parser/Atomic.hs +++ b/src/Parser/Atomic.hs @@ -9,16 +9,14 @@ import Text.Parsec.String parseAtomic :: Parser Atomic parseAtomic = - LiteralAtomic - <$> parseLiteral - <|> VariableAtomic - <$> parseVariableName - <|> parseFunctionCallAtomic + (LiteralAtomic <$> try parseLiteral) + <|> try parseFunctionCallAtomic + <|> (VariableAtomic <$> try parseVariableName) parseFunctionCallAtomic :: Parser Atomic parseFunctionCallAtomic = do - name <- parseVariableName + name <- try parseVariableName _ <- char '(' - args <- parseAtomic `sepBy` (spaces' >> char ',' >> spaces') + args <- try (parseAtomic `sepBy` (spaces' >> char ',' >> spaces')) _ <- char ')' return $ FunctionCallAtomic name args diff --git a/src/Parser/Expression.hs b/src/Parser/Expression.hs index bfe9a02..4281820 100644 --- a/src/Parser/Expression.hs +++ b/src/Parser/Expression.hs @@ -17,12 +17,12 @@ parseExpression = parseOperation :: Parser Expression parseOperation = do - left <- parseAtomicExpression -- left side has to be atomic to avoid endless loop becase of left recursion + left <- try parseAtomicExpression -- left side has to be atomic to avoid endless loop becase of left recursion _ <- spaces' - op <- parseOperator + op <- try parseOperator _ <- spaces' - OperationExpression left op <$> parseExpression + OperationExpression left op <$> try parseExpression parseAtomicExpression :: Parser Expression parseAtomicExpression = do - AtomicExpression <$> parseAtomic + AtomicExpression <$> try parseAtomic diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs index 2cb74cc..ecc7dbb 100644 --- a/src/Parser/Statement.hs +++ b/src/Parser/Statement.hs @@ -4,6 +4,7 @@ import AST import Control.Monad (void) import Parser.Assignment import Parser.EndOfLine +import Parser.Expression import Parser.Space import Parser.Type import Parser.Variable @@ -15,6 +16,7 @@ parseStatement = ( (VariableStatement <$> try (spaces' *> try parseVariable)) <|> (AssignmentStatement <$> try (spaces' *> try parseAssignment)) <|> (FunctionDefinitionStatement <$> try (spaces' *> try parseFunction)) + <|> ExpressionStatement <$> try (spaces' *> try parseExpression) ) <* spaces <* endOfStatement diff --git a/test/Spec.hs b/test/Spec.hs index 368ecd6..9ab2c8a 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,6 +1,7 @@ import E2E.Placeholder import Test.HUnit (Test (TestList), runTestTTAndExit) import Unit.Parser.Assignment +import Unit.Parser.Atomic import Unit.Parser.Comment import Unit.Parser.Expression import Unit.Parser.Program @@ -11,6 +12,7 @@ main = runTestTTAndExit ( TestList ( Unit.Parser.Assignment.allTests + ++ Unit.Parser.Atomic.allTests ++ Unit.Parser.Comment.allTests ++ Unit.Parser.Expression.allTests ++ Unit.Parser.Program.allTests diff --git a/test/Unit/Parser/Atomic.hs b/test/Unit/Parser/Atomic.hs new file mode 100644 index 0000000..b8cbbfb --- /dev/null +++ b/test/Unit/Parser/Atomic.hs @@ -0,0 +1,30 @@ +module Unit.Parser.Atomic (allTests) where + +import AST +import Data.Either (fromRight, isRight) +import Parser.Atomic +import Test.HUnit +import Text.Parsec (parse) + +allTests :: [Test] +allTests = + [ TestLabel "simple" testSimple + ] + +emptyTestAtomic :: Atomic +emptyTestAtomic = (LiteralAtomic (UnitLiteral)) + +testSimple :: Test +testSimple = TestCase $ do + assertEqual + "empty" + False + (isRight (parse parseAtomic "" "")) + assertEqual + "Single Number" + (LiteralAtomic (IntLiteral 1)) + (fromRight emptyTestAtomic (parse parseAtomic "" "1")) + assertEqual + "Function Call" + (FunctionCallAtomic "print" []) + (fromRight emptyTestAtomic (parse parseAtomic "" "print()")) diff --git a/test/Unit/Parser/Expression.hs b/test/Unit/Parser/Expression.hs index bbfb275..c3d784c 100644 --- a/test/Unit/Parser/Expression.hs +++ b/test/Unit/Parser/Expression.hs @@ -24,3 +24,7 @@ testSimple = TestCase $ do "Single Number" (AtomicExpression (LiteralAtomic (IntLiteral 1))) (fromRight emptyTestExpression (parse parseExpression "" "1")) + assertEqual + "Function Call" + (AtomicExpression (FunctionCallAtomic "print" [])) + (fromRight emptyTestExpression (parse parseExpression "" "print()")) diff --git a/test/Unit/Parser/Program.hs b/test/Unit/Parser/Program.hs index 5c6406c..9c3ed41 100644 --- a/test/Unit/Parser/Program.hs +++ b/test/Unit/Parser/Program.hs @@ -21,7 +21,7 @@ testSimple = TestCase $ do True (isRight (parse parseProgram "" "")) assertEqual - "Single variable statement" + "int k = 1;" ( Program [ VariableStatement ( Variable @@ -33,7 +33,7 @@ testSimple = TestCase $ do ) (fromRight emptyProgram (parse parseProgram "" "int k = 1;")) assertEqual - "Multiple variable statements" + "int k = 1; int j = 2;" ( Program [ VariableStatement ( Variable @@ -51,7 +51,7 @@ testSimple = TestCase $ do ) (fromRight emptyProgram (parse parseProgram "" "int k = 1; int j = 2;")) assertEqual - "Single assignment statement" + "k = 1;" ( Program [ AssignmentStatement ( Assignment @@ -63,7 +63,7 @@ testSimple = TestCase $ do ) (fromRight emptyProgram (parse parseProgram "" "k = 1;")) assertEqual - "variable statement and assignment statement" + "int k = 1; j = 2;" ( Program [ VariableStatement ( Variable @@ -80,3 +80,11 @@ testSimple = TestCase $ do ] ) (fromRight emptyProgram (parse parseProgram "" "int k = 1; j = 2;")) + assertEqual + "print();" + ( Program + [ ExpressionStatement + (AtomicExpression (FunctionCallAtomic "print" [])) + ] + ) + (fromRight emptyProgram (parse parseProgram "" "print();")) diff --git a/test/Unit/Parser/Statement.hs b/test/Unit/Parser/Statement.hs index 85ee803..e5a64ef 100644 --- a/test/Unit/Parser/Statement.hs +++ b/test/Unit/Parser/Statement.hs @@ -27,15 +27,15 @@ testSimple = TestCase $ do False (isRight (parse parseStatement "" "")) assertEqual - "var defintion" + "int i = 1;" (VariableStatement (Variable (VariableDeclaration "i" IntType) (AtomicExpression (LiteralAtomic (IntLiteral 1))))) (fromRight emptyTestStatement (parse parseStatement "" "int i = 1;")) assertEqual - "var assignment literal number" + "k = 2;" (AssignmentStatement (Assignment "k" (AtomicExpression (LiteralAtomic (IntLiteral 2))))) (fromRight emptyTestStatement (parse parseStatement "" "k = 2;")) assertEqual - "var assignment with var and number" + "k = k * 1;" ( AssignmentStatement ( Assignment "k" @@ -47,6 +47,10 @@ testSimple = TestCase $ do ) ) (fromRight emptyTestStatement (parse parseStatement "" "k = k * 1;")) + assertEqual + "print();" + (ExpressionStatement (AtomicExpression (FunctionCallAtomic "print" []))) + (fromRight emptyTestStatement (parse parseStatement "" "print();")) emptyTestFunction :: Function emptyTestFunction = Function "TEST" [] IntType [] @@ -58,11 +62,11 @@ testFunctions = TestCase $ do False (isRight (parse parseFunction "" "")) assertEqual - "empty main function" + "void main() { }" (Function "main" [] UnitType []) (fromRight emptyTestFunction (parse parseFunction "" "void main() { }")) assertEqual - "main function" + "void main() { int i = 1; i = 2; }" ( Function "main" [] @@ -73,7 +77,7 @@ testFunctions = TestCase $ do ) (fromRight emptyTestFunction (parse parseFunction "" "void main() { int i = 1; i = 2; }")) assertEqual - "function with arguments" + "float test(int i, int k) { }" ( (Function "test" [VariableDeclaration "i" IntType, VariableDeclaration "k" IntType] FloatType []) ) (fromRight emptyTestFunction (parse parseFunction "" "float test(int i, int k) { }"))