Merge pull request #10 from X-R-G-B/3-compute-ast

Compute basic ast

.gitignore

@@ -170,6 +170,7 @@ tags
 /glados
 
 *.log
+*.exe
 
 /make.exe
 /libssp-0.dll

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)"))

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

package.yaml

@@ -32,6 +32,9 @@ ghc-options:
 - -Wmissing-home-modules
 - -Wpartial-fields
 - -Wredundant-constraints
+- -Wdefault
+- -W
+- -Woperator-whitespace
 
 library:
   source-dirs: src

src/AST.hs

@@ -1,8 +1,8 @@
 {-
 -- EPITECH PROJECT, 2023
--- Abstract Syntax Tree
+-- Koaky
 -- File description:
--- ast
+-- Abstract Syntax Tree
 -}
 
 module AST

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

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 = <SYMBOL> <EXPRESSION>
+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

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

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))))])
+    ]