Skip to content
This repository has been archived by the owner on Dec 19, 2023. It is now read-only.

Interpreter v.1: Refactor Tree #12

Merged
merged 4 commits into from
Dec 7, 2023
Merged

Interpreter v.1: Refactor Tree #12

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
7319a1a
Interpreter v.1: Refactor Tree
guillaumeAbel Dec 6, 2023
1c88df0
Interpreter v.1: Fix test
guillaumeAbel Dec 6, 2023
76b6276
Interpreter v.1: Fix type + update tests
guillaumeAbel Dec 7, 2023
663352b
Interpreter v.1: Remove Maybe Tree
guillaumeAbel Dec 7, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 1 addition & 4 deletions app/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,8 +5,5 @@
-- Main
-}

import AST
import TextToAST

main :: IO ()
main = putStrLn (showMaybeTree (textToAST "(fst 1 (scd 2 3 4) 12)"))
main = putStrLn ("Hello, World!")
26 changes: 6 additions & 20 deletions src/AST.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,43 +8,29 @@
module AST
(
Symbol,
Atom (Number, Symbol, Boolean),
Tree (Node, Leaf, Variadic, Empty),
Tree (Number, Symbol, Boolean, List),
showMaybeTree
) where

import Data.Int (Int64)

type Symbol = String

data Atom = Number Int64 | Symbol Symbol | Boolean Bool

data Tree = Node Symbol (Maybe Tree) (Maybe Tree) | Leaf Atom | Variadic (Maybe Tree) (Maybe Tree) | Empty
data Tree = Number Int64 | Symbol Symbol | Boolean Bool | List [Tree]

showMaybeTree :: Maybe Tree -> String
showMaybeTree Nothing = "Nothing"
showMaybeTree (Just tree) = show tree

instance Eq Atom where
instance Eq Tree where
Number a == Number b = a == b
Symbol a == Symbol b = a == b
Boolean a == Boolean b = a == b
List a == List b = a == b
_ == _ = False

instance Show Atom where
instance Show Tree where
show (Number a) = "N:'" ++ show a ++ "'"
show (Symbol a) = "S:'" ++ a ++ "'"
show (Boolean value) = "B: " ++ show value

instance Eq Tree where
Node a fst_ scd == Node b bfst bscd = a == b && fst_ == bfst && scd == bscd
Leaf a == Leaf b = a == b
Variadic fst_ scd == Variadic bfst bscd = fst_ == bfst && scd == bscd
Empty == Empty = True
_ == _ = False

instance Show Tree where
show (Node value fst_ scd) = "Node:'" ++ value ++ "' first: '{" ++ showMaybeTree fst_ ++ "} second: {" ++ showMaybeTree scd ++ "}'"
show (Leaf value) = "Leaf:'" ++ show value ++ "'"
show (Variadic fst_ scd) = "Variadic first: {" ++ showMaybeTree fst_ ++ "} second: {" ++ showMaybeTree scd ++ "}"
show (Empty) = "Empty"
show (List list) = "L: " ++ show list
112 changes: 56 additions & 56 deletions src/ComputeAST.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,64 +7,64 @@

module ComputeAST
(
computeAST,
computeAllAST
--computeAST,
--computeAllAST
) where

import AST
import Defines
import Data.Int (Int64)
import Functions
--import AST
--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
--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
--
guillaumeAbel marked this conversation as resolved.
Show resolved Hide resolved
18 changes: 9 additions & 9 deletions src/Defines.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@
(
Define (Define),
Env (Env),
registerDefine,
--registerDefine,
getSymbolValue
) where

Expand All @@ -19,7 +19,7 @@
-- Define = <SYMBOL> <EXPRESSION>
data Define = Define {
symbol :: String,
expression :: Atom
expression :: Tree
} deriving (Show)

-- used to store defines, and more in the future
Expand All @@ -31,7 +31,7 @@
getSymbolValue :: Env -> String -> Int64
getSymbolValue (Env []) _ = 0
getSymbolValue (Env ((Define symbl value):rest)) symbolToFind
| symbl == symbolToFind = case value of

Check warning on line 34 in src/Defines.hs

View workflow job for this annotation

GitHub Actions / documentation 

Pattern match(es) are non-exhaustive

Check warning on line 34 in src/Defines.hs

View workflow job for this annotation

GitHub Actions / documentation 

Pattern match(es) are non-exhaustive

Check warning on line 34 in src/Defines.hs

View workflow job for this annotation

GitHub Actions / documentation 

Pattern match(es) are non-exhaustive

Check warning on line 34 in src/Defines.hs

View workflow job for this annotation

GitHub Actions / tests 

Pattern match(es) are non-exhaustive

Check warning on line 34 in src/Defines.hs

View workflow job for this annotation

GitHub Actions / compil-macos 

Pattern match(es) are non-exhaustive

Check warning on line 34 in src/Defines.hs

View workflow job for this annotation

GitHub Actions / compil-windows 

Pattern match(es) are non-exhaustive

Check warning on line 34 in src/Defines.hs

View workflow job for this annotation

GitHub Actions / compil-linux 

Pattern match(es) are non-exhaustive
(Number number) -> number
(Boolean True) -> 1
(Boolean False) -> 0
Expand All @@ -39,10 +39,10 @@
| 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
--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
135 changes: 68 additions & 67 deletions src/Functions.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,76 +7,77 @@

module Functions
(
additionTree,
substactionTree,
multiplicationTree,
divisionTree,
moduloTree
--additionTree,
--substactionTree,
--multiplicationTree,
--divisionTree,
--moduloTree
) where

import AST
import Defines
import Data.Int (Int64)
--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
--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
--
guillaumeAbel marked this conversation as resolved.
Show resolved Hide resolved
Loading
Loading