diff --git a/.gitignore b/.gitignore index b1e48a8..a01a2fd 100644 --- a/.gitignore +++ b/.gitignore @@ -170,6 +170,7 @@ tags /glados *.log +*.exe /make.exe /libssp-0.dll diff --git a/app/Main.hs b/app/Main.hs index 3298f61..47297c3 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,14 +1,12 @@ {- -- EPITECH PROJECT, 2023 --- Main +-- Koaky -- File description: -- Main -} -module Main (main) where - -import AST (showMaybeTree) -import TextToAST (textToAST) +import AST +import TextToAST main :: IO () main = putStrLn (showMaybeTree (textToAST "(fst 1 (scd 2 3 4) 12)")) diff --git a/koaky.cabal b/koaky.cabal index 7cccb21..6b57065 100644 --- a/koaky.cabal +++ b/koaky.cabal @@ -27,12 +27,14 @@ library exposed-modules: AST ComputeAST + Defines + Functions TextToAST other-modules: Paths_koaky hs-source-dirs: src - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wdefault -W -Woperator-whitespace build-depends: base >=4.7 && <5 default-language: Haskell2010 @@ -43,7 +45,7 @@ executable koaky-exe Paths_koaky hs-source-dirs: app - 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 + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wdefault -W -Woperator-whitespace -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 , koaky @@ -56,7 +58,7 @@ test-suite koaky-test Paths_koaky hs-source-dirs: test - 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 + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wdefault -W -Woperator-whitespace -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 , koaky diff --git a/package.yaml b/package.yaml index a961c6a..b4a3ae8 100644 --- a/package.yaml +++ b/package.yaml @@ -32,6 +32,9 @@ ghc-options: - -Wmissing-home-modules - -Wpartial-fields - -Wredundant-constraints +- -Wdefault +- -W +- -Woperator-whitespace library: source-dirs: src diff --git a/src/AST.hs b/src/AST.hs index 117523d..867d76e 100644 --- a/src/AST.hs +++ b/src/AST.hs @@ -1,8 +1,8 @@ {- -- EPITECH PROJECT, 2023 --- Abstract Syntax Tree +-- Koaky -- File description: --- ast +-- Abstract Syntax Tree -} module AST diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index fe2a59c..1d163ab 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -1,10 +1,70 @@ {- -- EPITECH PROJECT, 2023 --- Compute an AST +-- Koaky -- File description: -- ComputeAST -} module ComputeAST ( + computeAST, + computeAllAST ) where + +import AST +import Defines +import Data.Int (Int64) +import Functions + +------------ ComputeNode ------------ + +computeNode :: Env -> Tree -> Int64 +computeNode env tree@(Node "+" _ _) = additionTree env tree +computeNode env tree@(Node "-" _ _) = substactionTree env tree +computeNode env tree@(Node "*" _ _) = multiplicationTree env tree +computeNode env tree@(Node "div" _ _) = divisionTree env tree +computeNode env tree@(Node "mod" _ _) = moduloTree env tree +-- TODO: Error handling +computeNode _ _ = 0 + +------------ Resolve deepest ------------ + +resolveDeepestNode :: Env -> Tree -> Tree +-- Node [Leaf] [Leaf] +resolveDeepestNode env (Node symbol (Just (Leaf left)) (Just (Leaf right))) = + Leaf (Number (computeNode env + (Node symbol (Just (Leaf left)) (Just (Leaf right))))) +-- Node [Leaf] [Node] +resolveDeepestNode env (Node symbol (Just (Leaf left)) (Just right)) = + Node symbol (Just (Leaf left)) (Just $ resolveDeepestNode env right) +-- Node [Node] [Leaf] +resolveDeepestNode env (Node symbol (Just left) (Just (Leaf right))) = + Node symbol (Just $ resolveDeepestNode env left) (Just (Leaf right)) +-- Node [Node] [Node] +resolveDeepestNode env (Node symbol (Just left) (Just right)) = + Node symbol (Just $ resolveDeepestNode env left) + (Just $ resolveDeepestNode env right) +-- TODO: Error handling +resolveDeepestNode _ _ = (Leaf (Number 0)) + +------------ COMPUTE TREE ---------- + +computeTree :: Env -> Tree -> Atom +computeTree env (Leaf (Symbol symbol)) = Number (getSymbolValue env symbol) +computeTree _ (Leaf (Number number)) = Number number +computeTree _ (Leaf (Boolean value)) = Boolean value +computeTree env tree = computeTree env (resolveDeepestNode env tree) + +------------ COMPUTE AST ------------ + +computeAST :: Env -> Tree -> (Env, Maybe Atom) +computeAST env tree@(Node "define" _ _) = (registerDefine env tree, Nothing) +computeAST env tree = (env, Just (computeTree env tree)) + +-- Call computeAST on every tree in the list +computeAllAST :: Env -> [Tree] -> [Atom] +computeAllAST _ [] = [] +computeAllAST env (tree:rest) = case atom' of + Just atom -> atom : computeAllAST newEnv rest + Nothing -> computeAllAST newEnv rest + where (newEnv, atom') = computeAST env tree diff --git a/src/Defines.hs b/src/Defines.hs new file mode 100644 index 0000000..7fe80cd --- /dev/null +++ b/src/Defines.hs @@ -0,0 +1,48 @@ +{- +-- EPITECH PROJECT, 2023 +-- Koaky +-- File description: +-- Defines +-} + +module Defines + ( + Define (Define), + Env (Env), + registerDefine, + getSymbolValue + ) where + +import AST +import Data.Int (Int64) + +-- Define = +data Define = Define { + symbol :: String, + expression :: Atom +} deriving (Show) + +-- used to store defines, and more in the future +data Env = Env { + defines :: [Define] +} deriving (Show) + +-- TODO: Handle case where the define is a lambda / not defined +getSymbolValue :: Env -> String -> Int64 +getSymbolValue (Env []) _ = 0 +getSymbolValue (Env ((Define symbl value):rest)) symbolToFind + | symbl == symbolToFind = case value of + (Number number) -> number + (Boolean True) -> 1 + (Boolean False) -> 0 + (Symbol _) -> 0 + | otherwise = getSymbolValue (Env rest) symbolToFind + +-- Register a define in the Defines list +registerDefine :: Env -> Tree -> Env +registerDefine env + (Node "define" + (Just (Leaf (Symbol defSymbol))) + (Just (Leaf defexpression))) + = env { defines = defines env ++ [Define defSymbol defexpression] } +registerDefine env _ = env diff --git a/src/Functions.hs b/src/Functions.hs new file mode 100644 index 0000000..519f8b7 --- /dev/null +++ b/src/Functions.hs @@ -0,0 +1,82 @@ +{- +-- EPITECH PROJECT, 2023 +-- Koaky +-- File description: +-- ComputeAST +-} + +module Functions + ( + additionTree, + substactionTree, + multiplicationTree, + divisionTree, + moduloTree + ) where + +import AST +import Defines +import Data.Int (Int64) + +-- Compute a "+ - div * mod" node, using defines if needed +-- Todo: See for an error handling and division by 0 + +additionTree :: Env -> Tree -> Int64 +additionTree _ (Node "+" (Just (Leaf (Number left))) + (Just (Leaf (Number right)))) = left + right +additionTree env (Node "+" (Just (Leaf (Number left))) + (Just (Leaf (Symbol right)))) = left + getSymbolValue env right +additionTree env (Node "+" (Just (Leaf (Symbol left))) + (Just (Leaf (Number right)))) = getSymbolValue env left + right +additionTree env (Node "+" (Just (Leaf (Symbol left))) + (Just (Leaf (Symbol right)))) = + getSymbolValue env left + getSymbolValue env right +additionTree _ _ = 0 + +substactionTree :: Env -> Tree -> Int64 +substactionTree _ (Node "-" (Just (Leaf (Number left))) + (Just (Leaf (Number right)))) = left - right +substactionTree env (Node "-" (Just (Leaf (Number left))) + (Just (Leaf (Symbol right)))) = left - getSymbolValue env right +substactionTree env (Node "-" (Just (Leaf (Symbol left))) + (Just (Leaf (Number right)))) = getSymbolValue env left - right +substactionTree env (Node "-" (Just (Leaf (Symbol left))) + (Just (Leaf (Symbol right)))) = + getSymbolValue env left - getSymbolValue env right +substactionTree _ _ = 0 + +multiplicationTree :: Env -> Tree -> Int64 +multiplicationTree _ (Node "*" (Just (Leaf (Number left))) + (Just (Leaf (Number right)))) = left * right +multiplicationTree env (Node "*" (Just (Leaf (Number left))) + (Just (Leaf (Symbol right)))) = left * getSymbolValue env right +multiplicationTree env (Node "*" (Just (Leaf (Symbol left))) + (Just (Leaf (Number right)))) = getSymbolValue env left * right +multiplicationTree env (Node "*" (Just (Leaf (Symbol left))) + (Just (Leaf (Symbol right)))) = + getSymbolValue env left * getSymbolValue env right +multiplicationTree _ _ = 0 + +divisionTree :: Env -> Tree -> Int64 +divisionTree _ (Node "div" (Just (Leaf (Number left))) + (Just (Leaf (Number right)))) = left `div` right +divisionTree env (Node "div" (Just (Leaf (Number left))) + (Just (Leaf (Symbol right)))) = left `div` getSymbolValue env right +divisionTree env (Node "div" (Just (Leaf (Symbol left))) + (Just (Leaf (Number right)))) = getSymbolValue env left `div` right +divisionTree env (Node "div" (Just (Leaf (Symbol left))) + (Just (Leaf (Symbol right)))) = + getSymbolValue env left `div` getSymbolValue env right +divisionTree _ _ = 0 + +moduloTree :: Env -> Tree -> Int64 +moduloTree _ (Node "mod" (Just (Leaf (Number left))) + (Just (Leaf (Number right)))) = left `mod` right +moduloTree env (Node "mod" (Just (Leaf (Number left))) + (Just (Leaf (Symbol right)))) = left `mod` getSymbolValue env right +moduloTree env (Node "mod" (Just (Leaf (Symbol left))) + (Just (Leaf (Number right)))) = getSymbolValue env left `mod` right +moduloTree env (Node "mod" (Just (Leaf (Symbol left))) + (Just (Leaf (Symbol right)))) = + getSymbolValue env left `mod` getSymbolValue env right +moduloTree _ _ = 0 diff --git a/test/Spec.hs b/test/Spec.hs index 8879c79..e734185 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -4,12 +4,14 @@ import Test.Tasty.Runners.Html import AST import TextToAST +import ComputeAST +import Defines main :: IO () main = defaultMainWithIngredients (htmlRunner : defaultIngredients) tests tests :: TestTree -tests = testGroup "Tests" [unitTestsASTEqual, unitTestsASTParse] +tests = testGroup "Tests" [unitTestsASTEqual, unitTestsASTParse, unitTestASTCompute] unitTestsASTEqual :: TestTree unitTestsASTEqual = testGroup "AST Equal Tests" @@ -199,3 +201,47 @@ unitTestsASTParse = testGroup "AST Parse Tests" ) (textToAST "(do (re (mi)) 12 (re (mi)))") ] + +unitTestASTCompute :: TestTree +unitTestASTCompute = testGroup "AST compute Tests" + [ testCase "test1" $ + assertEqual "number 21 + number 21 = 42" + [Number 42] + (computeAllAST (Env []) [Node "+" (Just (Leaf (Number 21))) (Just (Leaf (Number 21)))]) + , testCase "test2" $ + assertEqual "define foo 42 and tree with leaf foo" + [Number 42] + (computeAllAST (Env []) [(Node "define" (Just (Leaf (Symbol "foo"))) (Just (Leaf (Number 42)))), (Leaf (Symbol "foo"))]) + , testCase "test3" $ + assertEqual "define foo 42 and do foo + 42" + [Number 84] + (computeAllAST (Env []) [(Node "define" (Just (Leaf (Symbol "foo"))) (Just (Leaf (Number 42)))), (Node "+" (Just (Leaf (Symbol "foo"))) (Just (Leaf (Number 42))))]) + , testCase "test3" $ + assertEqual "define foo 42 and do 42 + foo" + [Number 84] + (computeAllAST (Env []) [(Node "define" (Just (Leaf (Symbol "foo"))) (Just (Leaf (Number 42)))), (Node "+" (Just (Leaf (Number 42))) (Just (Leaf (Symbol "foo"))))]) + , testCase "test5" $ + assertEqual "define foo 42 and do foo + foo" + [Number 84] + (computeAllAST (Env []) [(Node "define" (Just (Leaf (Symbol "foo"))) (Just (Leaf (Number 42)))), (Node "+" (Just (Leaf (Symbol "foo"))) (Just (Leaf (Symbol "foo"))))]) + , testCase "test6" $ + assertEqual "define foo 42 and bar 21 and do foo + bar" + [Number 63] + (computeAllAST (Env []) [(Node "define" (Just (Leaf (Symbol "foo"))) (Just (Leaf (Number 42)))), (Node "define" (Just (Leaf (Symbol "bar"))) (Just (Leaf (Number 21)))), (Node "+" (Just (Leaf (Symbol "foo"))) (Just (Leaf (Symbol "bar"))))]) + , testCase "test7" $ + assertEqual "2 + (5 * 2) (result = 12)" + [Number 12] + (computeAllAST (Env []) [(Node "+" (Just (Leaf (Number 2))) (Just (Node "*" (Just (Leaf (Number 5))) (Just (Leaf (Number 2))))))]) + , testCase "test8" $ + assertEqual "(2 * 5) + (foo / 2) (result = 10 + 21 = 31)" + [Number 31] + (computeAllAST (Env []) [(Node "define" (Just (Leaf (Symbol "foo"))) (Just (Leaf (Number 42)))), Node "+" (Just (Node "*" (Just (Leaf (Number 2))) (Just (Leaf (Number 5))))) (Just (Node "div" (Just (Leaf (Symbol "foo"))) (Just (Leaf (Number 2)))))]) + , testCase "test9" $ + assertEqual "2 + 2 + (5 * 2) (result = 14)" + [Number 14] + (computeAllAST (Env []) [(Node "+" (Just (Leaf (Number 2))) (Just (Node "+" (Just (Leaf (Number 2))) (Just (Node "*" (Just (Leaf (Number 5))) (Just (Leaf (Number 2))))))))]) + , testCase "test10" $ + assertEqual "14 mod 5 (result = 4)" + [Number 4] + (computeAllAST (Env []) [(Node "mod" (Just (Leaf (Number 14))) (Just (Leaf (Number 5))))]) + ]