From c34c4ad6f15d143068266fd8089d3b75451505f2 Mon Sep 17 00:00:00 2001 From: guillaume abel Date: Tue, 12 Dec 2023 17:13:38 +0100 Subject: [PATCH 01/40] Add tests --- test/Spec.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index c013f58..0b02d1d 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -17,7 +17,8 @@ tests = testGroup "Tests" unitTestsComputeDefines, unitTestsComputeSimpleFunctions, unitTestsComputeBasics, - unitTestsASTParse + unitTestsASTParse, + unitTestsComputeFunctions ] unitTestsASTEqual :: TestTree @@ -198,3 +199,13 @@ unitTestsComputeBasics = testGroup "Tests compute basics" (Env {defines = [], errors = []}, [Just (Number 101)]) (computeAllAST (Env {defines = [], errors = []}) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 3, (List [Symbol "+", Number 8, (List [Symbol "*", Number 5, (List [Symbol "+", Number 2, Number 3])])])])])]) ] + +unitTestsComputeFunctions :: TestTree +unitTestsComputeFunctions = testGroup "Tests compute functions" + [ testCase "(define add (lambda (a b) (+ a b))), (add 1 2)" $ + assertEqual "(define add (lambda (a b) (+ a b))); (add 1 2)" + --empty if no parameters + [(List [Symbol "define", Symbol "add", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "+", Symbol "a", Symbol "b"]]]), (List [Symbol "add", Number 1, Number 2])] + , testCase "(define func (lambda (a b) (define foo a) (+ foo b))), (func 1 2)" $ + [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])] + ] From 7e1f54355f09729383c93ec76c142c02190c0688 Mon Sep 17 00:00:00 2001 From: tenshi Date: Wed, 13 Dec 2023 04:38:21 +0100 Subject: [PATCH 02/40] add begin of functions in env --- src/ComputeAST.hs | 2 ++ src/ComputeLists.hs | 6 +++++- src/Defines.hs | 27 ++++++++++++++++++++++----- src/Errors.hs | 4 ++-- src/Functions.hs | 11 ++++++++++- src/Types.hs | 16 ++++++++++++---- 6 files changed, 53 insertions(+), 13 deletions(-) diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index e35151f..6717fad 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -29,6 +29,8 @@ handleNoList env _ = (env, Nothing) -- Handle AST that register a define handleDefine :: Env -> Tree -> (Env, Maybe Result) +handleDefine env (List [Symbol _, Symbol smbl, List [Symbol "lambda", List params, List body]]) + = (registerFunction env smbl (List params) (List body), Nothing) handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl expr, Nothing) handleDefine env _ = (registerError env "Bad define", Nothing) diff --git a/src/ComputeLists.hs b/src/ComputeLists.hs index 7d2c251..c126621 100644 --- a/src/ComputeLists.hs +++ b/src/ComputeLists.hs @@ -13,6 +13,7 @@ module ComputeLists import Types import Functions +import Errors doesListContainsList :: [Tree] -> Bool doesListContainsList [] = False @@ -26,4 +27,7 @@ handleSimpleList env (Symbol "*" : rest) = multiplication env rest handleSimpleList env (Symbol "-" : rest) = subtraction env rest handleSimpleList env (Symbol "div" : rest) = division env rest handleSimpleList env (Symbol "mod" : rest) = modulo env rest -handleSimpleList env _ = (env, Nothing) +handleSimpleList env (Symbol smbl : rest) + | isAFunction env smbl = (env, Just (Number 4242)) + | otherwise = (registerError env ("Function " ++ smbl ++ " not found"), Nothing) +handleSimpleList env _ = (registerError env "Bad function call", Nothing) diff --git a/src/Defines.hs b/src/Defines.hs index ffcf89c..13ae81e 100644 --- a/src/Defines.hs +++ b/src/Defines.hs @@ -8,19 +8,36 @@ module Defines ( registerDefine, - getSymbolValue + getSymbolValue, + registerFunction ) where import Types +import Errors getSymbolValue :: Env -> String -> (Env, Maybe Tree) getSymbolValue (Env { defines = [], errors = _ }) _ = - (Env { defines = [], errors = [] }, Nothing) + (Env { defines = [], errors = [], functions = [] }, Nothing) getSymbolValue (Env { defines = (Define smbl value):xs, errors = err }) expr - | smbl == expr = (Env { defines = xs, errors = err }, Just value) - | otherwise = getSymbolValue (Env { defines = xs, errors = err }) expr + | smbl == expr = (Env { defines = xs, errors = err, functions = [] }, Just value) + | otherwise = getSymbolValue (Env { defines = xs, errors = err, functions = [] }) expr -- Register a define in the Defines list registerDefine :: Env -> Symbol -> Tree -> Env registerDefine env symb value = - Env (defines env ++ [Define symb value]) (errors env) + Env (defines env ++ [Define symb value]) (errors env) (functions env) + +-- Add a function to the Functions list in the Env +addFunction :: Env -> String -> [String] -> Tree -> Env +addFunction env name params body = Env (defines env) (errors env) (functions env ++ [Function name params body]) + +-- Get params from a function +getParams :: Tree -> [String] +getParams (List []) = [] +getParams (List (Symbol smbl : xs)) = smbl : getParams (List xs) +getParams _ = [] + +-- Register a function in the Functions list +registerFunction :: Env -> Symbol -> Tree -> Tree -> Env +registerFunction env "" _ _ = registerError env "function name must not be empty" +registerFunction env name params body = addFunction env name (getParams params) body diff --git a/src/Errors.hs b/src/Errors.hs index 0c51a6f..2d155af 100644 --- a/src/Errors.hs +++ b/src/Errors.hs @@ -19,7 +19,7 @@ import Types -- Add a new error to env registerError :: Env -> String -> Env -registerError env err = Env (defines env) (errors env ++ [err]) +registerError env err = Env (defines env) (errors env ++ [err]) (functions env) -- Get all errors getErrors :: Env -> [String] @@ -31,7 +31,7 @@ getLastError env = last (errors env) -- Clear all errors clearErrors :: Env -> Env -clearErrors env = Env (defines env) [] +clearErrors env = Env (defines env) [] (functions env) -- Print all errors printErrors :: Env -> IO () diff --git a/src/Functions.hs b/src/Functions.hs index 96e2656..88aa9b1 100644 --- a/src/Functions.hs +++ b/src/Functions.hs @@ -11,13 +11,22 @@ module Functions subtraction, multiplication, division, - modulo + modulo, + isAFunction ) where import Types import Errors import Defines +-- Find and execute user defined function + +isAFunction :: Env -> String -> Bool +isAFunction (Env { functions = [] }) _ = False +isAFunction (Env { functions = (Function name _ _):xs }) expr + | name == expr = True + | otherwise = isAFunction (Env { functions = xs }) expr + -- Compute a "+ - div * mod" list, using defines if needed addition :: Env -> [Tree] -> (Env, Maybe Result) diff --git a/src/Types.hs b/src/Types.hs index c6e4d95..b79e770 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -11,7 +11,8 @@ module Types Tree(..), Define(..), Env(..), - Result + Result, + Function(..) ) where import Data.Int (Int64) @@ -25,9 +26,16 @@ data Define = Define { expression :: Tree } deriving (Show) +data Function = Function { + name :: String, + params :: [String], + body :: Tree +} deriving (Show) + data Env = Env { defines :: [Define], - errors :: [String] + errors :: [String], + functions :: [Function] } type Result = Tree @@ -59,5 +67,5 @@ instance Show Tree where show (List list) = "L: " ++ show list instance Show Env where - show (Env { defines = def, errors = err }) = - "Defines: " ++ show def ++ "\nErrors: " ++ show err + show (Env { defines = def, errors = err, functions = func }) = + "Defines: " ++ show def ++ "\nErrors: " ++ show err ++ "\nFunctions: " ++ show func From 8969dea80e5e1a9b2a64d452ef99436a894898b6 Mon Sep 17 00:00:00 2001 From: tenshi Date: Wed, 13 Dec 2023 05:58:12 +0100 Subject: [PATCH 03/40] add working simple functions --- koaky.cabal | 4 +- src/ComputeAST.hs | 122 +++++++++++++++++++++++++++++++++++++++- src/ComputeDeepLists.hs | 44 --------------- src/ComputeLists.hs | 33 ----------- src/Functions.hs | 9 ++- test/Spec.hs | 106 +++++++++++++++++++--------------- 6 files changed, 190 insertions(+), 128 deletions(-) delete mode 100644 src/ComputeDeepLists.hs delete mode 100644 src/ComputeLists.hs diff --git a/koaky.cabal b/koaky.cabal index 0baea1b..32861ab 100644 --- a/koaky.cabal +++ b/koaky.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -27,8 +27,6 @@ library exposed-modules: AST ComputeAST - ComputeDeepLists - ComputeLists Defines Errors Functions diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index 6717fad..f0736af 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -13,8 +13,126 @@ module ComputeAST import Types import Defines import Errors -import ComputeDeepLists -import ComputeLists +import Functions + +-- Find nested lists and resolve them +resolveNestedLists :: Env -> [Tree] -> [Tree] -> (Env, Maybe [Tree]) +resolveNestedLists env resolvedList [] = (env, Just resolvedList) +resolveNestedLists env resolvedList (List list : rest) + | not (doesListContainsList list) = + case handleSimpleList env list of + (newEnv, Nothing) -> (newEnv, Nothing) + (newEnv, Just resolved) -> + resolveNestedLists newEnv (resolvedList ++ [resolved]) rest + | otherwise = case resolveNestedLists env [] list of + (newEnv, Nothing) -> (newEnv, Nothing) + (newEnv, Just rvd) + -> resolveNestedLists newEnv (resolvedList ++ [List rvd]) rest +resolveNestedLists env resolvedList (Number number : rest) = + resolveNestedLists env (resolvedList ++ [Number number]) rest +resolveNestedLists env resolvedList (Boolean value : rest) = + resolveNestedLists env (resolvedList ++ [Boolean value]) rest +resolveNestedLists env resolvedList (Symbol smbl : rest) = + resolveNestedLists env (resolvedList ++ [Symbol smbl]) rest + +-- Compute nested lists +handleDeepList :: Env -> [Tree] -> (Env, Maybe Result) +handleDeepList env list + | not (doesListContainsList list) = handleSimpleList env list + | otherwise = + case resolveNestedLists env [] list of + (newEnv, Nothing) -> (newEnv, Nothing) + (newEnv, Just resolvedList) -> handleDeepList newEnv resolvedList + + + + + + + + + + + + + + + + + + + +doesListContainsList :: [Tree] -> Bool +doesListContainsList [] = False +doesListContainsList (List _ : _) = True +doesListContainsList (_ : rest) = doesListContainsList rest + +--[(List [Symbol "define", Symbol "add", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "+", Symbol "a", Symbol "b"]]]), (List [Symbol "add", Number 1, Number 2])] +--[(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])] + +--data Function = Function { +-- name :: String, +-- params :: [String], +-- body :: Tree +--} deriving (Show) + + + + + +replaceSymbol :: Tree -> String -> Tree -> Tree +replaceSymbol (List lst) toReplace with = + List (map (\t -> if t == Symbol toReplace then with else replaceSymbol t toReplace with) lst) +replaceSymbol t _ _ = t + +replaceFunctionParams :: Env -> [String] -> Tree -> [Tree] -> (Env, Maybe Tree) +replaceFunctionParams env params body args + | length params /= length args = (registerError env "Mismatched number of arguments", Nothing) + | otherwise = + let replacement = zip params args + replacedBody = foldl (\b (p, a) -> replaceSymbol b p a) body replacement + in (env, Just replacedBody) + + +computeFunction :: Env -> Function -> [Tree] -> (Env, Maybe Result) +computeFunction env (Function name params body) args = + case replaceFunctionParams env params body args of + (newEnv, Nothing) -> (newEnv, Nothing) + (newEnv, Just replaced) -> computeAST newEnv replaced + +-- Compute simple lists (no nested lists) +handleSimpleList :: Env -> [Tree] -> (Env, Maybe Result) +handleSimpleList env (Symbol "+" : rest) = addition env rest +handleSimpleList env (Symbol "*" : rest) = multiplication env rest +handleSimpleList env (Symbol "-" : rest) = subtraction env rest +handleSimpleList env (Symbol "div" : rest) = division env rest +handleSimpleList env (Symbol "mod" : rest) = modulo env rest +handleSimpleList env (Symbol smbl : rest) + | isAFunction env smbl = case getFunctionByName env smbl of + Just func -> computeFunction env func rest + Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) + | otherwise = (registerError env ("Symbol " ++ smbl ++ " not found"), Nothing) +handleSimpleList env _ = (registerError env "Bad function call", Nothing) + + + + + + + + + + + + + + + + + + + + -- Handle AST that doesn't contain a list handleNoList :: Env -> Tree -> (Env, Maybe Result) diff --git a/src/ComputeDeepLists.hs b/src/ComputeDeepLists.hs deleted file mode 100644 index 61fc300..0000000 --- a/src/ComputeDeepLists.hs +++ /dev/null @@ -1,44 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- Compute nested lists --} - -module ComputeDeepLists - ( - handleDeepList, - resolveNestedLists - ) where - -import Types -import ComputeLists - --- Find nested lists and resolve them -resolveNestedLists :: Env -> [Tree] -> [Tree] -> (Env, Maybe [Tree]) -resolveNestedLists env resolvedList [] = (env, Just resolvedList) -resolveNestedLists env resolvedList (List list : rest) - | not (doesListContainsList list) = - case handleSimpleList env list of - (newEnv, Nothing) -> (newEnv, Nothing) - (newEnv, Just resolved) -> - resolveNestedLists newEnv (resolvedList ++ [resolved]) rest - | otherwise = case resolveNestedLists env [] list of - (newEnv, Nothing) -> (newEnv, Nothing) - (newEnv, Just rvd) - -> resolveNestedLists newEnv (resolvedList ++ [List rvd]) rest -resolveNestedLists env resolvedList (Number number : rest) = - resolveNestedLists env (resolvedList ++ [Number number]) rest -resolveNestedLists env resolvedList (Boolean value : rest) = - resolveNestedLists env (resolvedList ++ [Boolean value]) rest -resolveNestedLists env resolvedList (Symbol smbl : rest) = - resolveNestedLists env (resolvedList ++ [Symbol smbl]) rest - --- Compute nested lists -handleDeepList :: Env -> [Tree] -> (Env, Maybe Result) -handleDeepList env list - | not (doesListContainsList list) = handleSimpleList env list - | otherwise = - case resolveNestedLists env [] list of - (newEnv, Nothing) -> (newEnv, Nothing) - (newEnv, Just resolvedList) -> handleDeepList newEnv resolvedList diff --git a/src/ComputeLists.hs b/src/ComputeLists.hs deleted file mode 100644 index c126621..0000000 --- a/src/ComputeLists.hs +++ /dev/null @@ -1,33 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- Koaky --- File description: --- Compute simple lists --} - -module ComputeLists - ( - doesListContainsList, - handleSimpleList - ) where - -import Types -import Functions -import Errors - -doesListContainsList :: [Tree] -> Bool -doesListContainsList [] = False -doesListContainsList (List _ : _) = True -doesListContainsList (_ : rest) = doesListContainsList rest - --- Compute simple lists (no nested lists) -handleSimpleList :: Env -> [Tree] -> (Env, Maybe Result) -handleSimpleList env (Symbol "+" : rest) = addition env rest -handleSimpleList env (Symbol "*" : rest) = multiplication env rest -handleSimpleList env (Symbol "-" : rest) = subtraction env rest -handleSimpleList env (Symbol "div" : rest) = division env rest -handleSimpleList env (Symbol "mod" : rest) = modulo env rest -handleSimpleList env (Symbol smbl : rest) - | isAFunction env smbl = (env, Just (Number 4242)) - | otherwise = (registerError env ("Function " ++ smbl ++ " not found"), Nothing) -handleSimpleList env _ = (registerError env "Bad function call", Nothing) diff --git a/src/Functions.hs b/src/Functions.hs index 88aa9b1..a39d69e 100644 --- a/src/Functions.hs +++ b/src/Functions.hs @@ -12,7 +12,8 @@ module Functions multiplication, division, modulo, - isAFunction + isAFunction, + getFunctionByName ) where import Types @@ -27,6 +28,12 @@ isAFunction (Env { functions = (Function name _ _):xs }) expr | name == expr = True | otherwise = isAFunction (Env { functions = xs }) expr +getFunctionByName :: Env -> String -> Maybe Function +getFunctionByName (Env { functions = [] }) _ = Nothing +getFunctionByName (Env { functions = (Function name params body):xs }) expr + | name == expr = Just (Function name params body) + | otherwise = getFunctionByName (Env { functions = xs }) expr + -- Compute a "+ - div * mod" list, using defines if needed addition :: Env -> [Tree] -> (Env, Maybe Result) diff --git a/test/Spec.hs b/test/Spec.hs index 0b02d1d..5ef79d8 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -108,104 +108,120 @@ unitTestComputeTypes :: TestTree unitTestComputeTypes = testGroup "Tests Compute Types" [ testCase "bool true" $ assertEqual "bool true" - (Env {defines = [], errors = []}, Just (Boolean True)) - (computeAST (Env {defines = [], errors = []}) (Boolean True)) + (Env {defines = [], errors = [], functions = []}, Just (Boolean True)) + (computeAST (Env {defines = [], errors = [], functions = []}) (Boolean True)) , testCase "bool false" $ assertEqual "bool false" - (Env {defines = [], errors = []}, Just (Boolean False)) - (computeAST (Env {defines = [], errors = []}) (Boolean False)) + (Env {defines = [], errors = [], functions = []}, Just (Boolean False)) + (computeAST (Env {defines = [], errors = [], functions = []}) (Boolean False)) , testCase "number 42" $ assertEqual "number 42" - (Env {defines = [], errors = []}, Just (Number 42)) - (computeAST (Env {defines = [], errors = []}) (Number 42)) + (Env {defines = [], errors = [], functions = []}, Just (Number 42)) + (computeAST (Env {defines = [], errors = [], functions = []}) (Number 42)) , testCase "number -42" $ assertEqual "number -42" - (Env {defines = [], errors = []}, Just (Number (-42))) - (computeAST (Env {defines = [], errors = []}) (Number (-42))) + (Env {defines = [], errors = [], functions = []}, Just (Number (-42))) + (computeAST (Env {defines = [], errors = [], functions = []}) (Number (-42))) ] unitTestsComputeDefines :: TestTree unitTestsComputeDefines = testGroup "Tests Compute defines" [ testCase "define x 42" $ assertEqual "define x 42" - (Env {defines = [Define {symbol = "x", expression = Number 42}], errors = []}, Nothing) - (computeAST (Env {defines = [], errors = []}) (List [Symbol "define", Symbol "x", Number 42])) + (Env {defines = [Define {symbol = "x", expression = Number 42}], errors = [], functions = []}, Nothing) + (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "define", Symbol "x", Number 42])) , testCase "define x 42; x" $ assertEqual "define x 42; x" - (Env {defines = [Define {symbol = "x", expression = Number 42}], errors = []}, [Just (Number 42)]) - (computeAllAST (Env {defines = [], errors = []}) [(List [Symbol "define", Symbol "x", Number 42]), (Symbol "x")]) + (Env {defines = [Define {symbol = "x", expression = Number 42}], errors = [], functions = []}, [Just (Number 42)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", Number 42]), (Symbol "x")]) , testCase "define x 42; define y 84" $ assertEqual "define x 42; define y 84" - (Env {defines = [Define {symbol = "x", expression = Number 42}, Define {symbol = "y", expression = Number 84}], errors = []}, []) - (computeAllAST (Env {defines = [], errors = []}) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84])]) + (Env {defines = [Define {symbol = "x", expression = Number 42}, Define {symbol = "y", expression = Number 84}], errors = [], functions = []}, []) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84])]) , testCase "define x 42; define y 84; x; y" $ assertEqual "define x 42; define y 84; x; y" - (Env {defines = [Define {symbol = "x", expression = Number 42}, Define {symbol = "y", expression = Number 84}], errors = []}, [Just (Number 42), Just (Number 84)]) - (computeAllAST (Env {defines = [], errors = []}) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84]), (Symbol "x"), (Symbol "y")]) + (Env {defines = [Define {symbol = "x", expression = Number 42}, Define {symbol = "y", expression = Number 84}], errors = [], functions = []}, [Just (Number 42), Just (Number 84)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84]), (Symbol "x"), (Symbol "y")]) , testCase "define x (42 + 6); x" $ assertEqual "define x (42 + 6); x" - (Env {defines = [Define {symbol = "x", expression = List [Symbol "+", Number 42, Number 6]}], errors = []}, [Just (Number 48)]) - (computeAllAST (Env {defines = [], errors = []}) [(List [Symbol "define", Symbol "x", (List [Symbol "+", Number 42, Number 6])]), (Symbol "x")]) + (Env {defines = [Define {symbol = "x", expression = List [Symbol "+", Number 42, Number 6]}], errors = [], functions = []}, [Just (Number 48)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", (List [Symbol "+", Number 42, Number 6])]), (Symbol "x")]) ] unitTestsComputeSimpleFunctions :: TestTree unitTestsComputeSimpleFunctions = testGroup "Tests compute + - div mod" [ testCase "42 + 42" $ assertEqual "42 + 42" - (Env {defines = [], errors = []}, Just (Number 84)) - (computeAST (Env {defines = [], errors = []}) (List [Symbol "+", Number 42, Number 42])) + (Env {defines = [], errors = [], functions = []}, Just (Number 84)) + (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "+", Number 42, Number 42])) , testCase "-42 + -42" $ assertEqual "-42 + -42" - (Env {defines = [], errors = []}, Just (Number (-84))) - (computeAST (Env {defines = [], errors = []}) (List [Symbol "+", Number (-42), Number (-42)])) + (Env {defines = [], errors = [], functions = []}, Just (Number (-84))) + (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "+", Number (-42), Number (-42)])) , testCase "42 + dontexist" $ assertEqual "42 + dontexist" - (Env {defines = [], errors = ["Symbol not found"]}, Nothing) - (computeAST (Env {defines = [], errors = []}) (List [Symbol "+", Number 42, Symbol "dontexist"])) + (Env {defines = [], errors = ["Symbol not found"], functions = []}, Nothing) + (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "+", Number 42, Symbol "dontexist"])) , testCase "bool + number" $ assertEqual "bool + number" - (Env {defines = [], errors = ["Bad types in addition"]}, Nothing) - (computeAST (Env {defines = [], errors = []}) (List [Symbol "+", Boolean True, Number 42])) + (Env {defines = [], errors = ["Bad types in addition"], functions = []}, Nothing) + (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "+", Boolean True, Number 42])) , testCase "20 / 2 + 3 * 5 - 10" $ assertEqual "20 / 2 + 3 * 5 - 10" - (Env {defines = [], errors = []}, Just (Number 15)) - (computeAST (Env {defines = [], errors = []}) (List [Symbol "-", (List [Symbol "+", (List [Symbol "div", Number 20, Number 2]), (List [Symbol "*", Number 3, Number 5])]), Number 10])) + (Env {defines = [], errors = [], functions = []}, Just (Number 15)) + (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "-", (List [Symbol "+", (List [Symbol "div", Number 20, Number 2]), (List [Symbol "*", Number 3, Number 5])]), Number 10])) , testCase "11 mod 3" $ assertEqual "11 mod 3" - (Env {defines = [], errors = []}, Just (Number 2)) - (computeAST (Env {defines = [], errors = []}) (List [Symbol "mod", Number 11, Number 3])) + (Env {defines = [], errors = [], functions = []}, Just (Number 2)) + (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "mod", Number 11, Number 3])) ] unitTestsComputeBasics :: TestTree unitTestsComputeBasics = testGroup "Tests compute basics" [ testCase "define foo 42; foo + foo" $ assertEqual "define foo 42; foo + foo" - (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = []}, [Just (Number 84)]) - (computeAllAST (Env {defines = [], errors = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "+", Symbol "foo", Symbol "foo"])]) + (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Just (Number 84)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "+", Symbol "foo", Symbol "foo"])]) , testCase "define foo 42; define bar 42; foo + bar" $ assertEqual "define foo 42; define bar 42; foo + bar" - (Env {defines = [Define {symbol = "foo", expression = Number 42}, Define {symbol = "bar", expression = Number 42}], errors = []}, [Just (Number 84)]) - (computeAllAST (Env {defines = [], errors = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "define", Symbol "bar", Number 42]), (List [Symbol "+", Symbol "foo", Symbol "bar"])]) + (Env {defines = [Define {symbol = "foo", expression = Number 42}, Define {symbol = "bar", expression = Number 42}], errors = [], functions = []}, [Just (Number 84)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "define", Symbol "bar", Number 42]), (List [Symbol "+", Symbol "foo", Symbol "bar"])]) , testCase "2 + 2 * 5" $ assertEqual "2 + 2 * 5" - (Env {defines = [], errors = []}, [Just (Number 12)]) - (computeAllAST (Env {defines = [], errors = []}) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 2, Number 5])])]) + (Env {defines = [], errors = [], functions = []}, [Just (Number 12)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 2, Number 5])])]) , testCase "2 + 2 * (foo + 10) = 106" $ assertEqual "2 + 2 * (foo + 10) = 106" - (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = []}, [Just (Number 106)]) - (computeAllAST (Env {defines = [], errors = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "+", Number 2, (List [Symbol "*", Number 2, (List [Symbol "+", Symbol "foo", Number 10])])])]) + (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Just (Number 106)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "+", Number 2, (List [Symbol "*", Number 2, (List [Symbol "+", Symbol "foo", Number 10])])])]) , testCase "2 + 3 * (8 + (5* ( 2 + 3))) = 107" $ assertEqual "2 + 3 * (8 + (5* ( 2 + 3))) = 107" - (Env {defines = [], errors = []}, [Just (Number 101)]) - (computeAllAST (Env {defines = [], errors = []}) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 3, (List [Symbol "+", Number 8, (List [Symbol "*", Number 5, (List [Symbol "+", Number 2, Number 3])])])])])]) + (Env {defines = [], errors = [], functions = []}, [Just (Number 101)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 3, (List [Symbol "+", Number 8, (List [Symbol "*", Number 5, (List [Symbol "+", Number 2, Number 3])])])])])]) ] unitTestsComputeFunctions :: TestTree unitTestsComputeFunctions = testGroup "Tests compute functions" - [ testCase "(define add (lambda (a b) (+ a b))), (add 1 2)" $ + [ testCase "(define add (lambda (a b) (+ a b))); (add 1 2)" $ assertEqual "(define add (lambda (a b) (+ a b))); (add 1 2)" - --empty if no parameters - [(List [Symbol "define", Symbol "add", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "+", Symbol "a", Symbol "b"]]]), (List [Symbol "add", Number 1, Number 2])] - , testCase "(define func (lambda (a b) (define foo a) (+ foo b))), (func 1 2)" $ - [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])] + (Env {defines = [], errors = [], functions = [Function {name = "add", params = ["a", "b"], body = (List [Symbol "+", Symbol "a", Symbol "b"])}]}, [Just (Number 3)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "add", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "+", Symbol "a", Symbol "b"]]]), (List [Symbol "add", Number 1, Number 2])]) + , testCase "(define sub (lambda (a b) (- a b))); (sub 84 42)" $ + assertEqual "(define sub (lambda (a b) (- a b))); (sub 84 42)" + (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b"], body = (List [Symbol "-", Symbol "a", Symbol "b"])}]}, [Just (Number 42)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "-", Symbol "a", Symbol "b"]]]), (List [Symbol "sub", Number 84, Number 42])]) ] + + +-- unitTestsComputeFunctions :: TestTree +-- unitTestsComputeFunctions = testGroup "Tests compute functions" +-- [ testCase "(define add (lambda (a b) (+ a b))), (add 1 2)" $ +-- assertEqual "(define add (lambda (a b) (+ a b))); (add 1 2)" + +-- --[(List [Symbol "define", Symbol "add", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "+", Symbol "a", Symbol "b"]]]), (List [Symbol "add", Number 1, Number 2])] + +-- --, testCase "(define func (lambda (a b) (define foo a) (+ foo b))), (func 1 2)" $ + +-- -- [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])] +-- --, List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number2]] +-- ] --empty if no parameters From 1b0f4be9613ae5481513056b750f2347a4ff3260 Mon Sep 17 00:00:00 2001 From: tenshi Date: Wed, 13 Dec 2023 06:16:23 +0100 Subject: [PATCH 04/40] add more complex tests --- test/Spec.hs | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index 5ef79d8..5523f96 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -210,18 +210,15 @@ unitTestsComputeFunctions = testGroup "Tests compute functions" assertEqual "(define sub (lambda (a b) (- a b))); (sub 84 42)" (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b"], body = (List [Symbol "-", Symbol "a", Symbol "b"])}]}, [Just (Number 42)]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "-", Symbol "a", Symbol "b"]]]), (List [Symbol "sub", Number 84, Number 42])]) + , testCase "(define sub (lambda (a b c d e) (+ a (+ b (* 8 (+ d e))); (sub 84 42 1 2 3)" $ + assertEqual "(define sub (lambda (a b c d e) (+ a (+ b (* 8 (+ d e))); (sub 84 42 1 2 3)" + (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b", "c", "d", "e"], body = (List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])])}]}, [Just (Number 166)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b", Symbol "c", Symbol "d", Symbol "e" ], List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])]]]), (List [Symbol "sub", Number 84, Number 42, Number 1, Number 2, Number 3])]) + ] - - -- unitTestsComputeFunctions :: TestTree -- unitTestsComputeFunctions = testGroup "Tests compute functions" --- [ testCase "(define add (lambda (a b) (+ a b))), (add 1 2)" $ --- assertEqual "(define add (lambda (a b) (+ a b))); (add 1 2)" - --- --[(List [Symbol "define", Symbol "add", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "+", Symbol "a", Symbol "b"]]]), (List [Symbol "add", Number 1, Number 2])] - -- --, testCase "(define func (lambda (a b) (define foo a) (+ foo b))), (func 1 2)" $ - -- -- [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])] -- --, List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number2]] -- ] --empty if no parameters From d9a6ed175e9df450a7fb5f6ebb47934a02b3f8ce Mon Sep 17 00:00:00 2001 From: tenshi Date: Wed, 13 Dec 2023 08:40:21 +0100 Subject: [PATCH 05/40] add working function variables --- src/ComputeAST.hs | 49 +++++++++++++++++++++++++++++++---------------- src/Defines.hs | 8 ++++---- src/Types.hs | 2 +- test/Spec.hs | 14 ++++++++------ 4 files changed, 46 insertions(+), 27 deletions(-) diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index f0736af..ddfe979 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -90,16 +90,33 @@ replaceFunctionParams env params body args | length params /= length args = (registerError env "Mismatched number of arguments", Nothing) | otherwise = let replacement = zip params args - replacedBody = foldl (\b (p, a) -> replaceSymbol b p a) body replacement - in (env, Just replacedBody) + replacedbody = foldl (\acc (param, arg) -> replaceSymbol acc param arg) body replacement + in (env, Just replacedbody) +computeFunction' :: Env -> Function -> [Tree] -> (Env, Maybe Result) +computeFunction' env (Function _ _ []) _ = (env, Nothing) +computeFunction' env (Function name params (x:_)) args = + case replaceFunctionParams env params x args of + (newEnv, Nothing) -> (newEnv, Nothing) + (newEnv, Just replaced) -> computeAST newEnv replaced computeFunction :: Env -> Function -> [Tree] -> (Env, Maybe Result) -computeFunction env (Function name params body) args = - case replaceFunctionParams env params body args of - (newEnv, Nothing) -> (newEnv, Nothing) +computeFunction env (Function _ _ []) _ = (env, Nothing) +computeFunction env (Function name params (x:xs:rest)) args = + case computeFunction' env (Function name params [x]) args of + (newEnv, Nothing) -> computeFunction newEnv (Function name params (xs:rest)) args + (newEnv, Just replaced) -> (registerError newEnv "Return needs to be the last statement", Nothing) +computeFunction env (Function name params (x:_)) args = + case computeFunction' env (Function name params [x]) args of + (newEnv, Nothing) -> (registerError newEnv "Missing return in function", Nothing) (newEnv, Just replaced) -> computeAST newEnv replaced +-- computeFunction :: Env -> Function -> [Tree] -> (Env, Maybe Result) +-- computeFunction env (Function name params bodies) args = +-- case replaceFunctionParams env params bodies args of +-- (newEnv, Nothing) -> (newEnv, Nothing) +-- (newEnv, Just replaced) -> computeAST newEnv replaced + -- Compute simple lists (no nested lists) handleSimpleList :: Env -> [Tree] -> (Env, Maybe Result) handleSimpleList env (Symbol "+" : rest) = addition env rest @@ -107,11 +124,14 @@ handleSimpleList env (Symbol "*" : rest) = multiplication env rest handleSimpleList env (Symbol "-" : rest) = subtraction env rest handleSimpleList env (Symbol "div" : rest) = division env rest handleSimpleList env (Symbol "mod" : rest) = modulo env rest -handleSimpleList env (Symbol smbl : rest) - | isAFunction env smbl = case getFunctionByName env smbl of - Just func -> computeFunction env func rest +handleSimpleList env (Symbol smbl : rest) = + case getFunctionByName env smbl of + Just func -> + let (_, result) = computeFunction env func rest + in case result of + Just res -> (env, Just res) + Nothing -> (env, Nothing) Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) - | otherwise = (registerError env ("Symbol " ++ smbl ++ " not found"), Nothing) handleSimpleList env _ = (registerError env "Bad function call", Nothing) @@ -130,9 +150,6 @@ handleSimpleList env _ = (registerError env "Bad function call", Nothing) - - - -- Handle AST that doesn't contain a list handleNoList :: Env -> Tree -> (Env, Maybe Result) @@ -147,12 +164,12 @@ handleNoList env _ = (env, Nothing) -- Handle AST that register a define handleDefine :: Env -> Tree -> (Env, Maybe Result) -handleDefine env (List [Symbol _, Symbol smbl, List [Symbol "lambda", List params, List body]]) - = (registerFunction env smbl (List params) (List body), Nothing) -handleDefine env (List [Symbol _, Symbol smbl, expr]) - = (registerDefine env smbl expr, Nothing) +handleDefine env (List [Symbol _, Symbol smbl, List (Symbol "lambda": List params : bodies)]) = (registerFunction env smbl (List params) bodies, Nothing) +handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl expr, Nothing) handleDefine env _ = (registerError env "Bad define", Nothing) +--(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]) + -- Compute entire AST computeAST :: Env -> Tree -> (Env, Maybe Result) computeAST env tree@(List (Symbol "define" : _)) = handleDefine env tree diff --git a/src/Defines.hs b/src/Defines.hs index 13ae81e..61ffb7e 100644 --- a/src/Defines.hs +++ b/src/Defines.hs @@ -28,8 +28,8 @@ registerDefine env symb value = Env (defines env ++ [Define symb value]) (errors env) (functions env) -- Add a function to the Functions list in the Env -addFunction :: Env -> String -> [String] -> Tree -> Env -addFunction env name params body = Env (defines env) (errors env) (functions env ++ [Function name params body]) +addFunction :: Env -> String -> [String] -> [Tree] -> Env +addFunction env name params bodies = Env (defines env) (errors env) (functions env ++ [Function name params bodies]) -- Get params from a function getParams :: Tree -> [String] @@ -38,6 +38,6 @@ getParams (List (Symbol smbl : xs)) = smbl : getParams (List xs) getParams _ = [] -- Register a function in the Functions list -registerFunction :: Env -> Symbol -> Tree -> Tree -> Env +registerFunction :: Env -> Symbol -> Tree -> [Tree] -> Env registerFunction env "" _ _ = registerError env "function name must not be empty" -registerFunction env name params body = addFunction env name (getParams params) body +registerFunction env name params bodies = addFunction env name (getParams params) bodies diff --git a/src/Types.hs b/src/Types.hs index b79e770..54b9a67 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -29,7 +29,7 @@ data Define = Define { data Function = Function { name :: String, params :: [String], - body :: Tree + bodies :: [Tree] } deriving (Show) data Env = Env { diff --git a/test/Spec.hs b/test/Spec.hs index 5523f96..9aa2087 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -204,21 +204,23 @@ unitTestsComputeFunctions :: TestTree unitTestsComputeFunctions = testGroup "Tests compute functions" [ testCase "(define add (lambda (a b) (+ a b))); (add 1 2)" $ assertEqual "(define add (lambda (a b) (+ a b))); (add 1 2)" - (Env {defines = [], errors = [], functions = [Function {name = "add", params = ["a", "b"], body = (List [Symbol "+", Symbol "a", Symbol "b"])}]}, [Just (Number 3)]) + (Env {defines = [], errors = [], functions = [Function {name = "add", params = ["a", "b"], bodies = [(List [Symbol "+", Symbol "a", Symbol "b"])]}]}, [Just (Number 3)]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "add", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "+", Symbol "a", Symbol "b"]]]), (List [Symbol "add", Number 1, Number 2])]) , testCase "(define sub (lambda (a b) (- a b))); (sub 84 42)" $ assertEqual "(define sub (lambda (a b) (- a b))); (sub 84 42)" - (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b"], body = (List [Symbol "-", Symbol "a", Symbol "b"])}]}, [Just (Number 42)]) + (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b"], bodies = [(List [Symbol "-", Symbol "a", Symbol "b"])]}]}, [Just (Number 42)]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "-", Symbol "a", Symbol "b"]]]), (List [Symbol "sub", Number 84, Number 42])]) , testCase "(define sub (lambda (a b c d e) (+ a (+ b (* 8 (+ d e))); (sub 84 42 1 2 3)" $ assertEqual "(define sub (lambda (a b c d e) (+ a (+ b (* 8 (+ d e))); (sub 84 42 1 2 3)" - (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b", "c", "d", "e"], body = (List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])])}]}, [Just (Number 166)]) + (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b", "c", "d", "e"], bodies = [(List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])])]}]}, [Just (Number 166)]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b", Symbol "c", Symbol "d", Symbol "e" ], List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])]]]), (List [Symbol "sub", Number 84, Number 42, Number 1, Number 2, Number 3])]) - + , testCase "(define func (lambda (a b) (define foo a) (+ foo b))); (func 1 2)" $ + assertEqual "(define func (lambda (a b) (define foo a) (+ foo b))); (func 1 2)" + (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["a", "b"], bodies = [(List [Symbol "define", Symbol "foo", Symbol "a", (List [Symbol "+", Symbol "foo", Symbol "b"])])]}]}, [Just (Number 3)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])]) ] + -- unitTestsComputeFunctions :: TestTree -- unitTestsComputeFunctions = testGroup "Tests compute functions" --- --, testCase "(define func (lambda (a b) (define foo a) (+ foo b))), (func 1 2)" $ --- -- [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])] -- --, List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number2]] -- ] --empty if no parameters From b94ec5196d33d6e127fdc8e5fe44f63261a67f82 Mon Sep 17 00:00:00 2001 From: tenshi Date: Wed, 13 Dec 2023 10:52:06 +0100 Subject: [PATCH 06/40] add work in progress --- src/ComputeAST.hs | 182 +++++++++++++++++++++++++++++++++++++++++++++- src/Defines.hs | 8 -- src/Functions.hs | 134 +--------------------------------- test/Spec.hs | 18 +++-- 4 files changed, 194 insertions(+), 148 deletions(-) diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index ddfe979..0491365 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -15,6 +15,182 @@ import Defines import Errors import Functions +-- Find and execute user defined function + +getFunctionByName :: Env -> String -> Maybe Function +getFunctionByName (Env { functions = [] }) _ = Nothing +getFunctionByName (Env { functions = (Function name params body):xs }) expr + | name == expr = Just (Function name params body) + | otherwise = getFunctionByName (Env { functions = xs }) expr + +-- Compute a "+ - div * mod" list, using defines if needed + +addition :: Env -> [Tree] -> (Env, Maybe Result) +addition env [Number a, Number b] = (env, Just (Number (a + b))) +addition env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- getSymbolValue env b = + (env, Just (Number (a + symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +addition env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- getSymbolValue env a = + (env, Just (Number (symbolValue + b))) + | otherwise = (registerError env "Symbol not found", Nothing) +addition env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b = + (env, Just (Number (symbolValueA + symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +addition env list + | length list /= 2 = (registerError env "Addition need 2 params", Nothing) + | otherwise = (registerError env "Bad types in addition", Nothing) + +multiplication :: Env -> [Tree] -> (Env, Maybe Result) +multiplication env [Number a, Number b] = (env, Just (Number (a * b))) +multiplication env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- getSymbolValue env b = + (env, Just (Number (a * symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +multiplication env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- getSymbolValue env a = + (env, Just (Number (symbolValue * b))) + | otherwise = (registerError env "Symbol not found", Nothing) +multiplication env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b = + (env, Just (Number (symbolValueA * symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +multiplication env list + | length list /= 2 = (registerError env "* need 2 params", Nothing) + | otherwise = (registerError env "Bad types in multiplication", Nothing) + +subtraction :: Env -> [Tree] -> (Env, Maybe Result) +subtraction env [Number a, Number b] = (env, Just (Number (a - b))) +subtraction env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- getSymbolValue env b = + (env, Just (Number (a - symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +subtraction env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- getSymbolValue env a = + (env, Just (Number (symbolValue - b))) + | otherwise = (registerError env "Symbol not found", Nothing) +subtraction env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b = + (env, Just (Number (symbolValueA - symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +subtraction env list + | length list /= 2 = (registerError env "- need 2 params", Nothing) + | otherwise = (registerError env "Bad types in subtraction", Nothing) + +division :: Env -> [Tree] -> (Env, Maybe Result) +division env [Number a, Number b] + | b == 0 = (registerError env "Division by 0", Nothing) + | otherwise = (env, Just (Number (a `div` b))) +division env [Symbol a, Number b] + | b == 0 = (registerError env "Division by 0", Nothing) + | (_, Just (Number symbolValue)) <- getSymbolValue env a = + (env, Just (Number (symbolValue `div` b))) + | otherwise = (registerError env "Symbol not found", Nothing) +division env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- getSymbolValue env b + , symbolValue == 0 = (registerError env "Division by 0", Nothing) + | (_, Just (Number symbolValue)) <- getSymbolValue env b = + (env, Just (Number (a `div` symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +division env [Symbol a, Symbol b] + | (_, Just (Number _)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b + , symbolValueB == 0 = (registerError env "Division by 0", Nothing) + | (_, Just (Number symbolValueA)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b = + (env, Just (Number (symbolValueA `div` symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +division env list + | length list /= 2 = (registerError env "/ need 2 params", Nothing) + | otherwise = (registerError env "Bad types in division", Nothing) + +modulo :: Env -> [Tree] -> (Env, Maybe Result) +modulo env [Number a, Number b] + | b == 0 = (registerError env "Modulo by 0", Nothing) + | otherwise = (env, Just (Number (a `mod` b))) +modulo env [Symbol a, Number b] + | b == 0 = (registerError env "Modulo by 0", Nothing) + | (_, Just (Number symbolValue)) <- getSymbolValue env a = + (env, Just (Number (symbolValue `mod` b))) + | otherwise = (registerError env "Symbol not found", Nothing) +modulo env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- getSymbolValue env b + , symbolValue == 0 = (registerError env "Modulo by 0", Nothing) + | (_, Just (Number symbolValue)) <- getSymbolValue env b = + (env, Just (Number (a `mod` symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +modulo env [Symbol a, Symbol b] + | (_, Just (Number _)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b + , symbolValueB == 0 = (registerError env "Modulo by 0", Nothing) + | (_, Just (Number symbolValueA)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b = + (env, Just (Number (symbolValueA `mod` symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +modulo env list + | length list /= 2 = (registerError env "% need 2 params", Nothing) + | otherwise = (registerError env "Bad types in modulo", Nothing) + + + + + + + + + + + + + + + + + + + + + +isAFunction :: Env -> String -> Bool +isAFunction (Env { functions = [] }) _ = False +isAFunction (Env { functions = (Function name _ _):xs }) expr + | name == expr = True + | otherwise = isAFunction (Env { functions = xs }) expr + +getSymbolValueFromFunction :: Env -> String -> (Env, Maybe Tree) +getSymbolValueFromFunction env@(Env { functions = [] }) symbl = (env, Nothing) +getSymbolValueFromFunction env@(Env { functions = (Function name params bodies):xs }) symbl + | name == symbl = case computeFunction env (Function name params bodies) [] of + (newEnv, Nothing) -> (registerError newEnv "Function call failed", Nothing) + (newEnv, Just result) -> (env, Just result) + | otherwise = getSymbolValueFromFunction (Env { functions = xs }) symbl + +getSymbolValueFromDefine :: Env -> String -> (Env, Maybe Tree) +getSymbolValueFromDefine env@(Env { defines = [] }) symbl = (env, Nothing) +getSymbolValueFromDefine env@(Env { defines = (Define smbl value):xs }) + symbl + | smbl == symbl = (env, Just value) + | otherwise = getSymbolValueFromDefine (Env { defines = xs }) symbl + +getSymbolValue :: Env -> String -> (Env, Maybe Tree) +getSymbolValue env symbl + | isAFunction env symbl = getSymbolValueFromFunction env symbl + | otherwise = getSymbolValueFromDefine env symbl + + + + + + + + + + -- Find nested lists and resolve them resolveNestedLists :: Env -> [Tree] -> [Tree] -> (Env, Maybe [Tree]) resolveNestedLists env resolvedList [] = (env, Just resolvedList) @@ -110,6 +286,7 @@ computeFunction env (Function name params (x:_)) args = case computeFunction' env (Function name params [x]) args of (newEnv, Nothing) -> (registerError newEnv "Missing return in function", Nothing) (newEnv, Just replaced) -> computeAST newEnv replaced +computeFunction env _ _ = (registerError env "Bad function call", Nothing) -- computeFunction :: Env -> Function -> [Tree] -> (Env, Maybe Result) -- computeFunction env (Function name params bodies) args = @@ -127,10 +304,10 @@ handleSimpleList env (Symbol "mod" : rest) = modulo env rest handleSimpleList env (Symbol smbl : rest) = case getFunctionByName env smbl of Just func -> - let (_, result) = computeFunction env func rest + let (newEnv, result) = computeFunction env func rest in case result of Just res -> (env, Just res) - Nothing -> (env, Nothing) + Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) handleSimpleList env _ = (registerError env "Bad function call", Nothing) @@ -169,6 +346,7 @@ handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl handleDefine env _ = (registerError env "Bad define", Nothing) --(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]) +--(List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number2]] -- Compute entire AST computeAST :: Env -> Tree -> (Env, Maybe Result) diff --git a/src/Defines.hs b/src/Defines.hs index 61ffb7e..27d2497 100644 --- a/src/Defines.hs +++ b/src/Defines.hs @@ -8,20 +8,12 @@ module Defines ( registerDefine, - getSymbolValue, registerFunction ) where import Types import Errors -getSymbolValue :: Env -> String -> (Env, Maybe Tree) -getSymbolValue (Env { defines = [], errors = _ }) _ = - (Env { defines = [], errors = [], functions = [] }, Nothing) -getSymbolValue (Env { defines = (Define smbl value):xs, errors = err }) expr - | smbl == expr = (Env { defines = xs, errors = err, functions = [] }, Just value) - | otherwise = getSymbolValue (Env { defines = xs, errors = err, functions = [] }) expr - -- Register a define in the Defines list registerDefine :: Env -> Symbol -> Tree -> Env registerDefine env symb value = diff --git a/src/Functions.hs b/src/Functions.hs index a39d69e..2ba07b0 100644 --- a/src/Functions.hs +++ b/src/Functions.hs @@ -7,142 +7,10 @@ module Functions ( - addition, - subtraction, - multiplication, - division, - modulo, - isAFunction, - getFunctionByName + ) where import Types import Errors import Defines --- Find and execute user defined function - -isAFunction :: Env -> String -> Bool -isAFunction (Env { functions = [] }) _ = False -isAFunction (Env { functions = (Function name _ _):xs }) expr - | name == expr = True - | otherwise = isAFunction (Env { functions = xs }) expr - -getFunctionByName :: Env -> String -> Maybe Function -getFunctionByName (Env { functions = [] }) _ = Nothing -getFunctionByName (Env { functions = (Function name params body):xs }) expr - | name == expr = Just (Function name params body) - | otherwise = getFunctionByName (Env { functions = xs }) expr - --- Compute a "+ - div * mod" list, using defines if needed - -addition :: Env -> [Tree] -> (Env, Maybe Result) -addition env [Number a, Number b] = (env, Just (Number (a + b))) -addition env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a + symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -addition env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue + b))) - | otherwise = (registerError env "Symbol not found", Nothing) -addition env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA + symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -addition env list - | length list /= 2 = (registerError env "Addition need 2 params", Nothing) - | otherwise = (registerError env "Bad types in addition", Nothing) - -multiplication :: Env -> [Tree] -> (Env, Maybe Result) -multiplication env [Number a, Number b] = (env, Just (Number (a * b))) -multiplication env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a * symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -multiplication env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue * b))) - | otherwise = (registerError env "Symbol not found", Nothing) -multiplication env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA * symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -multiplication env list - | length list /= 2 = (registerError env "* need 2 params", Nothing) - | otherwise = (registerError env "Bad types in multiplication", Nothing) - -subtraction :: Env -> [Tree] -> (Env, Maybe Result) -subtraction env [Number a, Number b] = (env, Just (Number (a - b))) -subtraction env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a - symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -subtraction env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue - b))) - | otherwise = (registerError env "Symbol not found", Nothing) -subtraction env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA - symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -subtraction env list - | length list /= 2 = (registerError env "- need 2 params", Nothing) - | otherwise = (registerError env "Bad types in subtraction", Nothing) - -division :: Env -> [Tree] -> (Env, Maybe Result) -division env [Number a, Number b] - | b == 0 = (registerError env "Division by 0", Nothing) - | otherwise = (env, Just (Number (a `div` b))) -division env [Symbol a, Number b] - | b == 0 = (registerError env "Division by 0", Nothing) - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue `div` b))) - | otherwise = (registerError env "Symbol not found", Nothing) -division env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b - , symbolValue == 0 = (registerError env "Division by 0", Nothing) - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a `div` symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -division env [Symbol a, Symbol b] - | (_, Just (Number _)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b - , symbolValueB == 0 = (registerError env "Division by 0", Nothing) - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA `div` symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -division env list - | length list /= 2 = (registerError env "/ need 2 params", Nothing) - | otherwise = (registerError env "Bad types in division", Nothing) - -modulo :: Env -> [Tree] -> (Env, Maybe Result) -modulo env [Number a, Number b] - | b == 0 = (registerError env "Modulo by 0", Nothing) - | otherwise = (env, Just (Number (a `mod` b))) -modulo env [Symbol a, Number b] - | b == 0 = (registerError env "Modulo by 0", Nothing) - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue `mod` b))) - | otherwise = (registerError env "Symbol not found", Nothing) -modulo env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b - , symbolValue == 0 = (registerError env "Modulo by 0", Nothing) - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a `mod` symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -modulo env [Symbol a, Symbol b] - | (_, Just (Number _)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b - , symbolValueB == 0 = (registerError env "Modulo by 0", Nothing) - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA `mod` symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -modulo env list - | length list /= 2 = (registerError env "% need 2 params", Nothing) - | otherwise = (registerError env "Bad types in modulo", Nothing) diff --git a/test/Spec.hs b/test/Spec.hs index 9aa2087..296dca3 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -218,9 +218,17 @@ unitTestsComputeFunctions = testGroup "Tests compute functions" assertEqual "(define func (lambda (a b) (define foo a) (+ foo b))); (func 1 2)" (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["a", "b"], bodies = [(List [Symbol "define", Symbol "foo", Symbol "a", (List [Symbol "+", Symbol "foo", Symbol "b"])])]}]}, [Just (Number 3)]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])]) + , testCase "((lambda (a b) (+ a b)) 1 2)" $ + assertEqual "((lambda (a b) (+ a b)) 1 2)" + (Env {defines = [], errors = [], functions = []}, Just (Number 3)) + (computeAST (Env {defines = [], errors = [], functions = []}) (List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number 2]])) + , testCase "(define func (lambda () (define foo 42) (foo))); (func)" $ + assertEqual "(define func (lambda () (define foo 42) (foo))); (func)" + (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "define", Symbol "foo", Symbol "42"], Symbol "foo"]}]}, [Just (Number 42)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "define", Symbol "foo", Symbol "42"], Symbol "foo"]]), (Symbol "func")]) + , testCase "(define func (lambda () (+ 42 42))); (func)" $ + assertEqual "(define func (lambda () (+ 42 42))); (func)" + (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "+", Symbol "42", Symbol "42"]]}]}, [Just (Number 84)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "+", Symbol "42", Symbol "42"]]]), (Symbol "func")]) ] - --- unitTestsComputeFunctions :: TestTree --- unitTestsComputeFunctions = testGroup "Tests compute functions" --- --, List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number2]] --- ] --empty if no parameters +-- ] --empty if no parameters \ No newline at end of file From 92a755d17e93c4812708c6ae36bb3c39ef6e9a83 Mon Sep 17 00:00:00 2001 From: Tenshi Date: Wed, 13 Dec 2023 11:56:12 +0100 Subject: [PATCH 07/40] fix tests --- src/ComputeAST.hs | 176 ---------------------------------------------- src/Defines.hs | 10 ++- src/Functions.hs | 127 ++++++++++++++++++++++++++++++++- test/Spec.hs | 5 +- 4 files changed, 137 insertions(+), 181 deletions(-) diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index 0491365..4c9db82 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -15,182 +15,6 @@ import Defines import Errors import Functions --- Find and execute user defined function - -getFunctionByName :: Env -> String -> Maybe Function -getFunctionByName (Env { functions = [] }) _ = Nothing -getFunctionByName (Env { functions = (Function name params body):xs }) expr - | name == expr = Just (Function name params body) - | otherwise = getFunctionByName (Env { functions = xs }) expr - --- Compute a "+ - div * mod" list, using defines if needed - -addition :: Env -> [Tree] -> (Env, Maybe Result) -addition env [Number a, Number b] = (env, Just (Number (a + b))) -addition env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a + symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -addition env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue + b))) - | otherwise = (registerError env "Symbol not found", Nothing) -addition env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA + symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -addition env list - | length list /= 2 = (registerError env "Addition need 2 params", Nothing) - | otherwise = (registerError env "Bad types in addition", Nothing) - -multiplication :: Env -> [Tree] -> (Env, Maybe Result) -multiplication env [Number a, Number b] = (env, Just (Number (a * b))) -multiplication env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a * symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -multiplication env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue * b))) - | otherwise = (registerError env "Symbol not found", Nothing) -multiplication env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA * symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -multiplication env list - | length list /= 2 = (registerError env "* need 2 params", Nothing) - | otherwise = (registerError env "Bad types in multiplication", Nothing) - -subtraction :: Env -> [Tree] -> (Env, Maybe Result) -subtraction env [Number a, Number b] = (env, Just (Number (a - b))) -subtraction env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a - symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -subtraction env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue - b))) - | otherwise = (registerError env "Symbol not found", Nothing) -subtraction env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA - symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -subtraction env list - | length list /= 2 = (registerError env "- need 2 params", Nothing) - | otherwise = (registerError env "Bad types in subtraction", Nothing) - -division :: Env -> [Tree] -> (Env, Maybe Result) -division env [Number a, Number b] - | b == 0 = (registerError env "Division by 0", Nothing) - | otherwise = (env, Just (Number (a `div` b))) -division env [Symbol a, Number b] - | b == 0 = (registerError env "Division by 0", Nothing) - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue `div` b))) - | otherwise = (registerError env "Symbol not found", Nothing) -division env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b - , symbolValue == 0 = (registerError env "Division by 0", Nothing) - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a `div` symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -division env [Symbol a, Symbol b] - | (_, Just (Number _)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b - , symbolValueB == 0 = (registerError env "Division by 0", Nothing) - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA `div` symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -division env list - | length list /= 2 = (registerError env "/ need 2 params", Nothing) - | otherwise = (registerError env "Bad types in division", Nothing) - -modulo :: Env -> [Tree] -> (Env, Maybe Result) -modulo env [Number a, Number b] - | b == 0 = (registerError env "Modulo by 0", Nothing) - | otherwise = (env, Just (Number (a `mod` b))) -modulo env [Symbol a, Number b] - | b == 0 = (registerError env "Modulo by 0", Nothing) - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue `mod` b))) - | otherwise = (registerError env "Symbol not found", Nothing) -modulo env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b - , symbolValue == 0 = (registerError env "Modulo by 0", Nothing) - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a `mod` symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -modulo env [Symbol a, Symbol b] - | (_, Just (Number _)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b - , symbolValueB == 0 = (registerError env "Modulo by 0", Nothing) - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA `mod` symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -modulo env list - | length list /= 2 = (registerError env "% need 2 params", Nothing) - | otherwise = (registerError env "Bad types in modulo", Nothing) - - - - - - - - - - - - - - - - - - - - - -isAFunction :: Env -> String -> Bool -isAFunction (Env { functions = [] }) _ = False -isAFunction (Env { functions = (Function name _ _):xs }) expr - | name == expr = True - | otherwise = isAFunction (Env { functions = xs }) expr - -getSymbolValueFromFunction :: Env -> String -> (Env, Maybe Tree) -getSymbolValueFromFunction env@(Env { functions = [] }) symbl = (env, Nothing) -getSymbolValueFromFunction env@(Env { functions = (Function name params bodies):xs }) symbl - | name == symbl = case computeFunction env (Function name params bodies) [] of - (newEnv, Nothing) -> (registerError newEnv "Function call failed", Nothing) - (newEnv, Just result) -> (env, Just result) - | otherwise = getSymbolValueFromFunction (Env { functions = xs }) symbl - -getSymbolValueFromDefine :: Env -> String -> (Env, Maybe Tree) -getSymbolValueFromDefine env@(Env { defines = [] }) symbl = (env, Nothing) -getSymbolValueFromDefine env@(Env { defines = (Define smbl value):xs }) - symbl - | smbl == symbl = (env, Just value) - | otherwise = getSymbolValueFromDefine (Env { defines = xs }) symbl - -getSymbolValue :: Env -> String -> (Env, Maybe Tree) -getSymbolValue env symbl - | isAFunction env symbl = getSymbolValueFromFunction env symbl - | otherwise = getSymbolValueFromDefine env symbl - - - - - - - - - - -- Find nested lists and resolve them resolveNestedLists :: Env -> [Tree] -> [Tree] -> (Env, Maybe [Tree]) resolveNestedLists env resolvedList [] = (env, Just resolvedList) diff --git a/src/Defines.hs b/src/Defines.hs index 27d2497..09388be 100644 --- a/src/Defines.hs +++ b/src/Defines.hs @@ -8,12 +8,20 @@ module Defines ( registerDefine, - registerFunction + registerFunction, + getSymbolValue ) where import Types import Errors +getSymbolValue :: Env -> String -> (Env, Maybe Tree) +getSymbolValue (Env { defines = [], errors = _, functions = _ }) _ = + (Env { defines = [], errors = [], functions = [] }, Nothing) +getSymbolValue (Env { defines = (Define smbl value):xs, errors = err }) expr + | smbl == expr = (Env { defines = xs, errors = err, functions = [] }, Just value) + | otherwise = getSymbolValue (Env { defines = xs, errors = err, functions = [] }) expr + -- Register a define in the Defines list registerDefine :: Env -> Symbol -> Tree -> Env registerDefine env symb value = diff --git a/src/Functions.hs b/src/Functions.hs index 2ba07b0..7492c85 100644 --- a/src/Functions.hs +++ b/src/Functions.hs @@ -7,10 +7,135 @@ module Functions ( - + getFunctionByName, + addition, + multiplication, + subtraction, + division, + modulo ) where import Types import Errors import Defines +-- Find and execute user defined function + +getFunctionByName :: Env -> String -> Maybe Function +getFunctionByName (Env { functions = [] }) _ = Nothing +getFunctionByName (Env { functions = (Function name params body):xs }) expr + | name == expr = Just (Function name params body) + | otherwise = getFunctionByName (Env { functions = xs }) expr + +-- Compute a "+ - div * mod" list, using defines if needed + +addition :: Env -> [Tree] -> (Env, Maybe Result) +addition env [Number a, Number b] = (env, Just (Number (a + b))) +addition env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- getSymbolValue env b = + (env, Just (Number (a + symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +addition env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- getSymbolValue env a = + (env, Just (Number (symbolValue + b))) + | otherwise = (registerError env "Symbol not found", Nothing) +addition env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b = + (env, Just (Number (symbolValueA + symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +addition env list + | length list /= 2 = (registerError env "Addition need 2 params", Nothing) + | otherwise = (registerError env "Bad types in addition", Nothing) + +multiplication :: Env -> [Tree] -> (Env, Maybe Result) +multiplication env [Number a, Number b] = (env, Just (Number (a * b))) +multiplication env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- getSymbolValue env b = + (env, Just (Number (a * symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +multiplication env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- getSymbolValue env a = + (env, Just (Number (symbolValue * b))) + | otherwise = (registerError env "Symbol not found", Nothing) +multiplication env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b = + (env, Just (Number (symbolValueA * symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +multiplication env list + | length list /= 2 = (registerError env "* need 2 params", Nothing) + | otherwise = (registerError env "Bad types in multiplication", Nothing) + +subtraction :: Env -> [Tree] -> (Env, Maybe Result) +subtraction env [Number a, Number b] = (env, Just (Number (a - b))) +subtraction env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- getSymbolValue env b = + (env, Just (Number (a - symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +subtraction env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- getSymbolValue env a = + (env, Just (Number (symbolValue - b))) + | otherwise = (registerError env "Symbol not found", Nothing) +subtraction env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b = + (env, Just (Number (symbolValueA - symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +subtraction env list + | length list /= 2 = (registerError env "- need 2 params", Nothing) + | otherwise = (registerError env "Bad types in subtraction", Nothing) + +division :: Env -> [Tree] -> (Env, Maybe Result) +division env [Number a, Number b] + | b == 0 = (registerError env "Division by 0", Nothing) + | otherwise = (env, Just (Number (a `div` b))) +division env [Symbol a, Number b] + | b == 0 = (registerError env "Division by 0", Nothing) + | (_, Just (Number symbolValue)) <- getSymbolValue env a = + (env, Just (Number (symbolValue `div` b))) + | otherwise = (registerError env "Symbol not found", Nothing) +division env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- getSymbolValue env b + , symbolValue == 0 = (registerError env "Division by 0", Nothing) + | (_, Just (Number symbolValue)) <- getSymbolValue env b = + (env, Just (Number (a `div` symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +division env [Symbol a, Symbol b] + | (_, Just (Number _)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b + , symbolValueB == 0 = (registerError env "Division by 0", Nothing) + | (_, Just (Number symbolValueA)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b = + (env, Just (Number (symbolValueA `div` symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +division env list + | length list /= 2 = (registerError env "/ need 2 params", Nothing) + | otherwise = (registerError env "Bad types in division", Nothing) + +modulo :: Env -> [Tree] -> (Env, Maybe Result) +modulo env [Number a, Number b] + | b == 0 = (registerError env "Modulo by 0", Nothing) + | otherwise = (env, Just (Number (a `mod` b))) +modulo env [Symbol a, Number b] + | b == 0 = (registerError env "Modulo by 0", Nothing) + | (_, Just (Number symbolValue)) <- getSymbolValue env a = + (env, Just (Number (symbolValue `mod` b))) + | otherwise = (registerError env "Symbol not found", Nothing) +modulo env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- getSymbolValue env b + , symbolValue == 0 = (registerError env "Modulo by 0", Nothing) + | (_, Just (Number symbolValue)) <- getSymbolValue env b = + (env, Just (Number (a `mod` symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +modulo env [Symbol a, Symbol b] + | (_, Just (Number _)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b + , symbolValueB == 0 = (registerError env "Modulo by 0", Nothing) + | (_, Just (Number symbolValueA)) <- getSymbolValue env a + , (_, Just (Number symbolValueB)) <- getSymbolValue env b = + (env, Just (Number (symbolValueA `mod` symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +modulo env list + | length list /= 2 = (registerError env "% need 2 params", Nothing) + | otherwise = (registerError env "Bad types in modulo", Nothing) diff --git a/test/Spec.hs b/test/Spec.hs index 296dca3..a9346a8 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -225,10 +225,9 @@ unitTestsComputeFunctions = testGroup "Tests compute functions" , testCase "(define func (lambda () (define foo 42) (foo))); (func)" $ assertEqual "(define func (lambda () (define foo 42) (foo))); (func)" (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "define", Symbol "foo", Symbol "42"], Symbol "foo"]}]}, [Just (Number 42)]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "define", Symbol "foo", Symbol "42"], Symbol "foo"]]), (Symbol "func")]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "define", Symbol "foo", Symbol "42"], Symbol "foo"]]), (List [Symbol "func"])]) , testCase "(define func (lambda () (+ 42 42))); (func)" $ assertEqual "(define func (lambda () (+ 42 42))); (func)" (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "+", Symbol "42", Symbol "42"]]}]}, [Just (Number 84)]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "+", Symbol "42", Symbol "42"]]]), (Symbol "func")]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "+", Symbol "42", Symbol "42"]]]), (List [Symbol "func"])]) ] --- ] --empty if no parameters \ No newline at end of file From 0c0bed3ec23182ba4462cd388bfde84b24481ebe Mon Sep 17 00:00:00 2001 From: Tenshi Date: Wed, 13 Dec 2023 14:41:45 +0100 Subject: [PATCH 08/40] add lambda support MINOR --- src/ComputeAST.hs | 12 ++++++++---- src/Defines.hs | 3 ++- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index 4c9db82..7fb4cf9 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -14,6 +14,7 @@ import Types import Defines import Errors import Functions +import Debug.Trace -- Find nested lists and resolve them resolveNestedLists :: Env -> [Tree] -> [Tree] -> (Env, Maybe [Tree]) @@ -58,10 +59,6 @@ handleDeepList env list - - - - doesListContainsList :: [Tree] -> Bool doesListContainsList [] = False doesListContainsList (List _ : _) = True @@ -172,9 +169,16 @@ handleDefine env _ = (registerError env "Bad define", Nothing) --(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]) --(List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number2]] +handleLambda :: Env -> Tree -> (Env, Maybe Result) +handleLambda env (List (List (Symbol "lambda" : List params : bodies): (List args): _)) + = computeFunction env (Function "" (getParams (List params)) bodies) args +handleLambda env _ = (registerError env "Bad lambda", Nothing) + -- Compute entire AST computeAST :: Env -> Tree -> (Env, Maybe Result) computeAST env tree@(List (Symbol "define" : _)) = handleDefine env tree +--(List [List [Symbol "lambda", L +computeAST env tree@(List (List (Symbol "lambda" : _) : _)) = handleLambda env tree computeAST env (List list) | doesListContainsList list = handleDeepList env list | otherwise = handleSimpleList env list diff --git a/src/Defines.hs b/src/Defines.hs index 09388be..0fe7a47 100644 --- a/src/Defines.hs +++ b/src/Defines.hs @@ -9,7 +9,8 @@ module Defines ( registerDefine, registerFunction, - getSymbolValue + getSymbolValue, + getParams ) where import Types From 21b5d99810f5638bb8c8403ba53c017afcdf0650 Mon Sep 17 00:00:00 2001 From: Xavier Mitault Date: Fri, 15 Dec 2023 20:16:10 +0100 Subject: [PATCH 09/40] Add option for koaky --- app/Args.hs | 60 ++++++++++++++++++++++++++++++++++++++++ app/Main.hs | 42 ++++++++-------------------- app/Run.hs | 62 ++++++++++++++++++++++++++++++++++++++++++ app/Version.hs | 15 ++++++++++ koaky.cabal | 4 +++ src/KoakyLibVersion.hs | 33 ++++++++++++++++++++++ 6 files changed, 186 insertions(+), 30 deletions(-) create mode 100644 app/Args.hs create mode 100644 app/Run.hs create mode 100644 app/Version.hs create mode 100644 src/KoakyLibVersion.hs diff --git a/app/Args.hs b/app/Args.hs new file mode 100644 index 0000000..9f79d11 --- /dev/null +++ b/app/Args.hs @@ -0,0 +1,60 @@ +{- +-- EPITECH PROJECT, 2023 +-- Koaky +-- File description: +-- args +-} + + +module Args + ( + Action(..), + Args(..), + RunOpt(..), + parseArgs, + printHelp + ) where + +data Action = ShowHelp | ShowVersion | Run +data RunOpt = RunStdin | RunFile + +data Args = Args { + action :: Action, + runOpt :: RunOpt, + filePath :: String +} + +parseArgs' :: [String] -> Args -> Either Args String +parseArgs' [] args = + Left args +parseArgs' ("--help":xs) args = + parseArgs' xs (args {action = ShowHelp}) +parseArgs' ("-h":xs) args = + parseArgs' xs (args {action = ShowHelp}) +parseArgs' ("--version":xs) args = + parseArgs' xs (args {action = ShowVersion}) +parseArgs' ("-v":xs) args = + parseArgs' xs (args {action = ShowVersion}) +parseArgs' ("-f":f:xs) args = + parseArgs' xs (args {action = Run, runOpt = RunFile, filePath = f}) +parseArgs' ["-f"] _ = + Right "No file specified" +parseArgs' ("-":xs) args = + parseArgs' xs (args {action = Run, runOpt = RunStdin}) +parseArgs' (x:_) _ = + Right ("Unknown option: " ++ x) + +parseArgs :: [String] -> Either Args String +parseArgs args = + parseArgs' args (Args {action = Run, runOpt = RunStdin, filePath = ""}) + +printHelp :: IO () +printHelp = putStr help + where + line1 = "Usage: koaky [OPTION]\n\n" + line1a = "Options:\n" + line2 = "\t-h, --help\n\t\tDisplay this help and exit\n" + line3 = "\t-v, --version\n\t\tOutput version information and exit\n" + line4 = "\t-f FILE, --file FILE\n\t\tRead FILE and Interpret it\n" + line5 = "\t-\n\t\tRead from standard input and Interpret it (default)\n" + help = line1 ++ line1a ++ line2 ++ line3 ++ line4 ++ line5 diff --git a/app/Main.hs b/app/Main.hs index ee3fcd9..cf421bf 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -5,35 +5,17 @@ -- Main -} -import Computing.ComputeAST -import Parsing.Parser -import Types -import System.IO - -printErrors :: (Env) -> IO () -printErrors (Env defines_ []) = - printErrors (Env defines_ ["Unable to compute"]) -printErrors (Env defines_ errors_) = - mapM_ putStrLn errors_ >> handleInput (Env defines_ []) - -checkComputing :: (Env, Maybe Result) -> IO () -checkComputing (env, Nothing) = printErrors env -checkComputing (env, Just result) = putStrLn (show result) >> handleInput env - -checkParsing :: Maybe (Tree, String) -> Env -> IO () -checkParsing Nothing _ = return () -checkParsing (Just (tree, _)) env = checkComputing (computeAST env tree) - -checkInput :: String -> Env -> IO () -checkInput ":q" _ = return () -checkInput input env = checkParsing (runParser (parseTree) input) env - -checkEOF :: Env -> Bool -> IO () -checkEOF _ True = return () -checkEOF env False = getLine >>= (\x -> checkInput x env) - -handleInput :: Env -> IO () -handleInput env = isEOF >>= (\x -> checkEOF env x) +import System.Environment (getArgs) +import Args +import Run +import Version + +dispatchAction :: Either Args String -> IO () +dispatchAction (Right error_) = putStrLn error_ +dispatchAction (Left (Args ShowHelp _ _)) = printHelp +dispatchAction (Left (Args ShowVersion _ _)) = printVersion +dispatchAction (Left (Args Run RunFile f)) = runFile f +dispatchAction (Left (Args Run RunStdin _)) = runStdin main :: IO () -main = handleInput (Env [] []) +main = getArgs >>= (dispatchAction . parseArgs) diff --git a/app/Run.hs b/app/Run.hs new file mode 100644 index 0000000..55caba0 --- /dev/null +++ b/app/Run.hs @@ -0,0 +1,62 @@ +{- +-- EPITECH PROJECT, 2023 +-- Koaky +-- File description: +-- run +-} + +module Run + ( + runStdin, + runFile + ) where + +import Computing.ComputeAST +import Parsing.Parser +import Types +import System.IO + +data HHHandle = HHHandle Handle Bool + +printErrors :: HHHandle -> Env -> IO () +printErrors hand (Env defines_ []) = + printErrors hand (Env defines_ ["Unable to compute"]) +printErrors hand (Env defines_ errors_) = + mapM_ putStrLn errors_ >> handleInput hand (Env defines_ []) + +checkComputing :: HHHandle -> (Env, Maybe Result) -> IO () +checkComputing hand (env, Nothing) = printErrors hand env +checkComputing hand (env, Just result) = print result >> handleInput hand env + +checkParsing :: HHHandle -> Maybe (Tree, String) -> Env -> IO () +checkParsing _ Nothing _ = return () +checkParsing hand (Just (tree, _)) env = + checkComputing hand (computeAST env tree) + +checkInput :: HHHandle -> String -> Env -> IO () +checkInput _ ":q" _ = return () +checkInput hand input env = checkParsing hand (runParser (parseTree) input) env + +checkEOF :: HHHandle -> Env -> Bool -> IO () +checkEOF _ _ True = return () +checkEOF (HHHandle ff shouldClosee) env False = hGetLine ff >>= + (\x -> checkInput (HHHandle ff shouldClosee) x env) + +handleInput :: HHHandle -> Env -> IO () +handleInput (HHHandle ff shouldClosee) env = + hIsEOF ff >>= (\x -> checkEOF (HHHandle ff shouldClosee) env x) + +runStdin :: IO () +runStdin = runFileHandle stdin False + +runFile :: String -> IO () +runFile filePath = openFile filePath ReadMode >>= \x -> runFileHandle x True + +onEnd :: HHHandle -> IO () +onEnd (HHHandle ff True) = hClose ff +onEnd _ = return () + +runFileHandle :: Handle -> Bool -> IO () +runFileHandle ff shouldClosee = + handleInput (HHHandle ff shouldClosee) (Env [] []) >> + onEnd (HHHandle ff shouldClosee) diff --git a/app/Version.hs b/app/Version.hs new file mode 100644 index 0000000..b9ea3fb --- /dev/null +++ b/app/Version.hs @@ -0,0 +1,15 @@ +{- +-- EPITECH PROJECT, 2023 +-- koaky +-- File description: +-- version +-} + +module Version + ( printVersion + ) where + +import KoakyLibVersion + +printVersion :: IO () +printVersion = putStrLn koakyLibVersion diff --git a/koaky.cabal b/koaky.cabal index 026aa9d..f7efbb0 100644 --- a/koaky.cabal +++ b/koaky.cabal @@ -32,6 +32,7 @@ library Computing.Defines Computing.Errors Computing.Functions + KoakyLibVersion Parsing.Parser Types other-modules: @@ -46,6 +47,9 @@ library executable koaky-exe main-is: Main.hs other-modules: + Args + Run + Version Paths_koaky hs-source-dirs: app diff --git a/src/KoakyLibVersion.hs b/src/KoakyLibVersion.hs new file mode 100644 index 0000000..7f4d84c --- /dev/null +++ b/src/KoakyLibVersion.hs @@ -0,0 +1,33 @@ +{- +-- EPITECH PROJECT, 2023 +-- koaky +-- File description: +-- lib version +-} + +module KoakyLibVersion + ( + koakyLibVersionPatch, + koakyLibVersionMinor, + koakyLibVersionMajor, + koakyLibVersion + ) + where + +koakyLibVersionPatch :: Int +koakyLibVersionPatch = 0 + +koakyLibVersionMinor :: Int +koakyLibVersionMinor = 0 + +koakyLibVersionMajor :: Int +koakyLibVersionMajor = 0 + + +koakyLibVersion :: String +koakyLibVersion = fullVersion + where + fMaj = show koakyLibVersionMajor + fMin = show koakyLibVersionMinor + fPat = show koakyLibVersionPatch + fullVersion = fMaj ++ "." ++ fMin ++ "." ++ fPat From 98b0f1c26ac3b5bc72da472b57c2ed5315c0c5d3 Mon Sep 17 00:00:00 2001 From: Xavier Mitault Date: Fri, 15 Dec 2023 20:21:36 +0100 Subject: [PATCH 10/40] Fixw norm --- app/Args.hs | 16 ++++++++++------ app/Version.hs | 8 ++++---- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/app/Args.hs b/app/Args.hs index 9f79d11..9cee6b0 100644 --- a/app/Args.hs +++ b/app/Args.hs @@ -52,9 +52,13 @@ printHelp :: IO () printHelp = putStr help where line1 = "Usage: koaky [OPTION]\n\n" - line1a = "Options:\n" - line2 = "\t-h, --help\n\t\tDisplay this help and exit\n" - line3 = "\t-v, --version\n\t\tOutput version information and exit\n" - line4 = "\t-f FILE, --file FILE\n\t\tRead FILE and Interpret it\n" - line5 = "\t-\n\t\tRead from standard input and Interpret it (default)\n" - help = line1 ++ line1a ++ line2 ++ line3 ++ line4 ++ line5 + line2 = "Interpret Lisp\n" + line2a = "With no options, koaky reads from standard input.\n\n" + line3 = "Options:\n" + line4 = "\t-h, --help\n\t\tDisplay this help and exit\n" + line5 = "\t-v, --version\n\t\tOutput version information and exit\n" + line6 = "\t-f FILE, --file FILE\n\t\tRead FILE and Interpret it\n" + line7 = "\t-\n\t\tRead from standard input and Interpret it\n" + help1 = line1 ++ line2 ++ line2a + help2 = line3 ++ line4 ++ line5 ++ line6 ++ line7 + help = help1 ++ help2 diff --git a/app/Version.hs b/app/Version.hs index b9ea3fb..815099c 100644 --- a/app/Version.hs +++ b/app/Version.hs @@ -1,8 +1,8 @@ {- --- EPITECH PROJECT, 2023 --- koaky --- File description: --- version +-- EPITECH PROJECT, 2023 +-- koaky +-- File description: +-- version -} module Version From 9d3970ff5e26c9ad038c3d15a9f7f29fc56449f7 Mon Sep 17 00:00:00 2001 From: Xavier Mitault Date: Fri, 15 Dec 2023 20:23:21 +0100 Subject: [PATCH 11/40] Fix norm --- app/Args.hs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/app/Args.hs b/app/Args.hs index 9cee6b0..c502b03 100644 --- a/app/Args.hs +++ b/app/Args.hs @@ -51,14 +51,11 @@ parseArgs args = printHelp :: IO () printHelp = putStr help where - line1 = "Usage: koaky [OPTION]\n\n" - line2 = "Interpret Lisp\n" + line1 = "Usage: koaky [OPTION]\n\nInterpret Lisp\n" line2a = "With no options, koaky reads from standard input.\n\n" line3 = "Options:\n" line4 = "\t-h, --help\n\t\tDisplay this help and exit\n" line5 = "\t-v, --version\n\t\tOutput version information and exit\n" line6 = "\t-f FILE, --file FILE\n\t\tRead FILE and Interpret it\n" line7 = "\t-\n\t\tRead from standard input and Interpret it\n" - help1 = line1 ++ line2 ++ line2a - help2 = line3 ++ line4 ++ line5 ++ line6 ++ line7 - help = help1 ++ help2 + help = line1 ++ line2a ++ line3 ++ line4 ++ line5 ++ line6 ++ line7 From d437d1b0d0da7e432b76fa7f1abcd8ecf6c38824 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sat, 16 Dec 2023 04:18:22 +0100 Subject: [PATCH 12/40] Clean code --- koaky.cabal | 2 + src/ComputeAST.hs | 122 +++++++---------------------------- src/Defines.hs | 8 ++- src/ListContainList.hs | 12 ++++ src/ReplaceFunctionParams.hs | 21 ++++++ 5 files changed, 65 insertions(+), 100 deletions(-) create mode 100644 src/ListContainList.hs create mode 100644 src/ReplaceFunctionParams.hs diff --git a/koaky.cabal b/koaky.cabal index 32861ab..f8ef3f4 100644 --- a/koaky.cabal +++ b/koaky.cabal @@ -30,7 +30,9 @@ library Defines Errors Functions + ListContainList Parser + ReplaceFunctionParams Types other-modules: Paths_koaky diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index 7fb4cf9..a6911c5 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -11,10 +11,11 @@ module ComputeAST ) where import Types +import ListContainList import Defines import Errors +import ReplaceFunctionParams import Functions -import Debug.Trace -- Find nested lists and resolve them resolveNestedLists :: Env -> [Tree] -> [Tree] -> (Env, Maybe [Tree]) @@ -36,6 +37,23 @@ resolveNestedLists env resolvedList (Boolean value : rest) = resolveNestedLists env resolvedList (Symbol smbl : rest) = resolveNestedLists env (resolvedList ++ [Symbol smbl]) rest + -- Compute simple lists (no nested lists) +handleSimpleList :: Env -> [Tree] -> (Env, Maybe Result) +handleSimpleList env (Symbol "+" : rest) = addition env rest +handleSimpleList env (Symbol "*" : rest) = multiplication env rest +handleSimpleList env (Symbol "-" : rest) = subtraction env rest +handleSimpleList env (Symbol "div" : rest) = division env rest +handleSimpleList env (Symbol "mod" : rest) = modulo env rest +handleSimpleList env (Symbol smbl : rest) = + case getFunctionByName env smbl of + Just func -> + let (newEnv, result) = computeFunction env func rest + in case result of + Just res -> (env, Just res) + Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) + Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) +handleSimpleList env _ = (registerError env "Bad function call", Nothing) + -- Compute nested lists handleDeepList :: Env -> [Tree] -> (Env, Maybe Result) handleDeepList env list @@ -45,50 +63,10 @@ handleDeepList env list (newEnv, Nothing) -> (newEnv, Nothing) (newEnv, Just resolvedList) -> handleDeepList newEnv resolvedList - - - - - - - - - - - - - - -doesListContainsList :: [Tree] -> Bool -doesListContainsList [] = False -doesListContainsList (List _ : _) = True -doesListContainsList (_ : rest) = doesListContainsList rest - ---[(List [Symbol "define", Symbol "add", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "+", Symbol "a", Symbol "b"]]]), (List [Symbol "add", Number 1, Number 2])] ---[(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])] - ---data Function = Function { --- name :: String, --- params :: [String], --- body :: Tree ---} deriving (Show) - - - - - -replaceSymbol :: Tree -> String -> Tree -> Tree -replaceSymbol (List lst) toReplace with = - List (map (\t -> if t == Symbol toReplace then with else replaceSymbol t toReplace with) lst) -replaceSymbol t _ _ = t - -replaceFunctionParams :: Env -> [String] -> Tree -> [Tree] -> (Env, Maybe Tree) -replaceFunctionParams env params body args - | length params /= length args = (registerError env "Mismatched number of arguments", Nothing) - | otherwise = - let replacement = zip params args - replacedbody = foldl (\acc (param, arg) -> replaceSymbol acc param arg) body replacement - in (env, Just replacedbody) +handleLambda :: Env -> Tree -> (Env, Maybe Result) +handleLambda env (List (List (Symbol "lambda" : List params : bodies): (List args): _)) + = computeFunction env (Function "" (getParams (List params)) bodies) args +handleLambda env _ = (registerError env "Bad lambda", Nothing) computeFunction' :: Env -> Function -> [Tree] -> (Env, Maybe Result) computeFunction' env (Function _ _ []) _ = (env, Nothing) @@ -109,46 +87,6 @@ computeFunction env (Function name params (x:_)) args = (newEnv, Just replaced) -> computeAST newEnv replaced computeFunction env _ _ = (registerError env "Bad function call", Nothing) --- computeFunction :: Env -> Function -> [Tree] -> (Env, Maybe Result) --- computeFunction env (Function name params bodies) args = --- case replaceFunctionParams env params bodies args of --- (newEnv, Nothing) -> (newEnv, Nothing) --- (newEnv, Just replaced) -> computeAST newEnv replaced - --- Compute simple lists (no nested lists) -handleSimpleList :: Env -> [Tree] -> (Env, Maybe Result) -handleSimpleList env (Symbol "+" : rest) = addition env rest -handleSimpleList env (Symbol "*" : rest) = multiplication env rest -handleSimpleList env (Symbol "-" : rest) = subtraction env rest -handleSimpleList env (Symbol "div" : rest) = division env rest -handleSimpleList env (Symbol "mod" : rest) = modulo env rest -handleSimpleList env (Symbol smbl : rest) = - case getFunctionByName env smbl of - Just func -> - let (newEnv, result) = computeFunction env func rest - in case result of - Just res -> (env, Just res) - Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) - Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) -handleSimpleList env _ = (registerError env "Bad function call", Nothing) - - - - - - - - - - - - - - - - - - -- Handle AST that doesn't contain a list handleNoList :: Env -> Tree -> (Env, Maybe Result) handleNoList env (Number nbr) = (env, Just (Number nbr)) @@ -160,20 +98,6 @@ handleNoList env (Symbol smbl) where (_, value) = getSymbolValue env smbl handleNoList env _ = (env, Nothing) --- Handle AST that register a define -handleDefine :: Env -> Tree -> (Env, Maybe Result) -handleDefine env (List [Symbol _, Symbol smbl, List (Symbol "lambda": List params : bodies)]) = (registerFunction env smbl (List params) bodies, Nothing) -handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl expr, Nothing) -handleDefine env _ = (registerError env "Bad define", Nothing) - ---(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]) ---(List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number2]] - -handleLambda :: Env -> Tree -> (Env, Maybe Result) -handleLambda env (List (List (Symbol "lambda" : List params : bodies): (List args): _)) - = computeFunction env (Function "" (getParams (List params)) bodies) args -handleLambda env _ = (registerError env "Bad lambda", Nothing) - -- Compute entire AST computeAST :: Env -> Tree -> (Env, Maybe Result) computeAST env tree@(List (Symbol "define" : _)) = handleDefine env tree diff --git a/src/Defines.hs b/src/Defines.hs index 0fe7a47..c303590 100644 --- a/src/Defines.hs +++ b/src/Defines.hs @@ -10,7 +10,8 @@ module Defines registerDefine, registerFunction, getSymbolValue, - getParams + getParams, + handleDefine ) where import Types @@ -42,3 +43,8 @@ getParams _ = [] registerFunction :: Env -> Symbol -> Tree -> [Tree] -> Env registerFunction env "" _ _ = registerError env "function name must not be empty" registerFunction env name params bodies = addFunction env name (getParams params) bodies + +handleDefine :: Env -> Tree -> (Env, Maybe Result) +handleDefine env (List [Symbol _, Symbol smbl, List (Symbol "lambda": List params : bodies)]) = (registerFunction env smbl (List params) bodies, Nothing) +handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl expr, Nothing) +handleDefine env _ = (registerError env "Bad define", Nothing) diff --git a/src/ListContainList.hs b/src/ListContainList.hs new file mode 100644 index 0000000..7b01088 --- /dev/null +++ b/src/ListContainList.hs @@ -0,0 +1,12 @@ + +module ListContainList + ( + doesListContainsList + ) where + +import Types + +doesListContainsList :: [Tree] -> Bool +doesListContainsList [] = False +doesListContainsList (List _ : _) = True +doesListContainsList (_ : rest) = doesListContainsList rest diff --git a/src/ReplaceFunctionParams.hs b/src/ReplaceFunctionParams.hs new file mode 100644 index 0000000..848a3c6 --- /dev/null +++ b/src/ReplaceFunctionParams.hs @@ -0,0 +1,21 @@ + +module ReplaceFunctionParams + ( + replaceFunctionParams + ) where + +import Types +import Errors + +replaceSymbol :: Tree -> String -> Tree -> Tree +replaceSymbol (List lst) toReplace with = + List (map (\t -> if t == Symbol toReplace then with else replaceSymbol t toReplace with) lst) +replaceSymbol t _ _ = t + +replaceFunctionParams :: Env -> [String] -> Tree -> [Tree] -> (Env, Maybe Tree) +replaceFunctionParams env params body args + | length params /= length args = (registerError env "Mismatched number of arguments", Nothing) + | otherwise = + let replacement = zip params args + replacedbody = foldl (\acc (param, arg) -> replaceSymbol acc param arg) body replacement + in (env, Just replacedbody) From 55c45556261d09bc18e5f201131202815f1f9d75 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sat, 16 Dec 2023 04:40:49 +0100 Subject: [PATCH 13/40] Add evaluateSymbol to compute list as define --- src/ComputeAST.hs | 135 ++++++++++++++++++++++++- src/Functions.hs | 244 +++++++++++++++++++++++----------------------- test/Spec.hs | 4 + 3 files changed, 259 insertions(+), 124 deletions(-) diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index a6911c5..a575ad9 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -7,7 +7,8 @@ module ComputeAST ( - computeAST + computeAST, + evaluateSymbol ) where import Types @@ -17,6 +18,137 @@ import Errors import ReplaceFunctionParams import Functions + +-- Find and execute user defined function + +getFunctionByName :: Env -> String -> Maybe Function +getFunctionByName (Env { functions = [] }) _ = Nothing +getFunctionByName (Env { functions = (Function name params body):xs }) expr + | name == expr = Just (Function name params body) + | otherwise = getFunctionByName (Env { functions = xs }) expr + +-- Compute a "+ - div * mod" list, using defines if needed + +addition :: Env -> [Tree] -> (Env, Maybe Result) +addition env [Number a, Number b] = (env, Just (Number (a + b))) +addition env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env b = + (env, Just (Number (a + symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +addition env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env a = + (env, Just (Number (symbolValue + b))) + | otherwise = (registerError env "Symbol not found", Nothing) +addition env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = + (env, Just (Number (symbolValueA + symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +addition env list + | length list /= 2 = (registerError env "Addition need 2 params", Nothing) + | otherwise = (registerError env "Bad types in addition", Nothing) + +multiplication :: Env -> [Tree] -> (Env, Maybe Result) +multiplication env [Number a, Number b] = (env, Just (Number (a * b))) +multiplication env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env b = + (env, Just (Number (a * symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +multiplication env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env a = + (env, Just (Number (symbolValue * b))) + | otherwise = (registerError env "Symbol not found", Nothing) +multiplication env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = + (env, Just (Number (symbolValueA * symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +multiplication env list + | length list /= 2 = (registerError env "* need 2 params", Nothing) + | otherwise = (registerError env "Bad types in multiplication", Nothing) + +subtraction :: Env -> [Tree] -> (Env, Maybe Result) +subtraction env [Number a, Number b] = (env, Just (Number (a - b))) +subtraction env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env b = + (env, Just (Number (a - symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +subtraction env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env a = + (env, Just (Number (symbolValue - b))) + | otherwise = (registerError env "Symbol not found", Nothing) +subtraction env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = + (env, Just (Number (symbolValueA - symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +subtraction env list + | length list /= 2 = (registerError env "- need 2 params", Nothing) + | otherwise = (registerError env "Bad types in subtraction", Nothing) + +division :: Env -> [Tree] -> (Env, Maybe Result) +division env [Number a, Number b] + | b == 0 = (registerError env "Division by 0", Nothing) + | otherwise = (env, Just (Number (a `div` b))) +division env [Symbol a, Number b] + | b == 0 = (registerError env "Division by 0", Nothing) + | (_, Just (Number symbolValue)) <- evaluateSymbol env a = + (env, Just (Number (symbolValue `div` b))) + | otherwise = (registerError env "Symbol not found", Nothing) +division env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env b + , symbolValue == 0 = (registerError env "Division by 0", Nothing) + | (_, Just (Number symbolValue)) <- evaluateSymbol env b = + (env, Just (Number (a `div` symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +division env [Symbol a, Symbol b] + | (_, Just (Number _)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b + , symbolValueB == 0 = (registerError env "Division by 0", Nothing) + | (_, Just (Number symbolValueA)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = + (env, Just (Number (symbolValueA `div` symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +division env list + | length list /= 2 = (registerError env "/ need 2 params", Nothing) + | otherwise = (registerError env "Bad types in division", Nothing) + +modulo :: Env -> [Tree] -> (Env, Maybe Result) +modulo env [Number a, Number b] + | b == 0 = (registerError env "Modulo by 0", Nothing) + | otherwise = (env, Just (Number (a `mod` b))) +modulo env [Symbol a, Number b] + | b == 0 = (registerError env "Modulo by 0", Nothing) + | (_, Just (Number symbolValue)) <- evaluateSymbol env a = + (env, Just (Number (symbolValue `mod` b))) + | otherwise = (registerError env "Symbol not found", Nothing) +modulo env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env b + , symbolValue == 0 = (registerError env "Modulo by 0", Nothing) + | (_, Just (Number symbolValue)) <- evaluateSymbol env b = + (env, Just (Number (a `mod` symbolValue))) + | otherwise = (registerError env "Symbol not found", Nothing) +modulo env [Symbol a, Symbol b] + | (_, Just (Number _)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b + , symbolValueB == 0 = (registerError env "Modulo by 0", Nothing) + | (_, Just (Number symbolValueA)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = + (env, Just (Number (symbolValueA `mod` symbolValueB))) + | otherwise = (registerError env "Symbol not found", Nothing) +modulo env list + | length list /= 2 = (registerError env "% need 2 params", Nothing) + | otherwise = (registerError env "Bad types in modulo", Nothing) + +evaluateSymbol :: Env -> Symbol -> (Env, Maybe Tree) +evaluateSymbol env smbl = + case getSymbolValue env smbl of + (_, Nothing) -> (env, Nothing) + (_, Just (Number number)) -> (env, Just (Number number)) + (_, Just (Boolean value)) -> (env, Just (Boolean value)) + (_, Just (List list)) -> computeAST env (List list) + (_, _) -> (env, Nothing) + -- Find nested lists and resolve them resolveNestedLists :: Env -> [Tree] -> [Tree] -> (Env, Maybe [Tree]) resolveNestedLists env resolvedList [] = (env, Just resolvedList) @@ -101,7 +233,6 @@ handleNoList env _ = (env, Nothing) -- Compute entire AST computeAST :: Env -> Tree -> (Env, Maybe Result) computeAST env tree@(List (Symbol "define" : _)) = handleDefine env tree ---(List [List [Symbol "lambda", L computeAST env tree@(List (List (Symbol "lambda" : _) : _)) = handleLambda env tree computeAST env (List list) | doesListContainsList list = handleDeepList env list diff --git a/src/Functions.hs b/src/Functions.hs index 7492c85..c7d8260 100644 --- a/src/Functions.hs +++ b/src/Functions.hs @@ -7,135 +7,135 @@ module Functions ( - getFunctionByName, - addition, - multiplication, - subtraction, - division, - modulo +-- getFunctionByName, +-- addition, +-- multiplication, +-- subtraction, +-- division, +-- modulo ) where -import Types -import Errors -import Defines +-- import Types +-- import Errors +-- import Defines --- Find and execute user defined function +-- -- Find and execute user defined function -getFunctionByName :: Env -> String -> Maybe Function -getFunctionByName (Env { functions = [] }) _ = Nothing -getFunctionByName (Env { functions = (Function name params body):xs }) expr - | name == expr = Just (Function name params body) - | otherwise = getFunctionByName (Env { functions = xs }) expr +-- getFunctionByName :: Env -> String -> Maybe Function +-- getFunctionByName (Env { functions = [] }) _ = Nothing +-- getFunctionByName (Env { functions = (Function name params body):xs }) expr +-- | name == expr = Just (Function name params body) +-- | otherwise = getFunctionByName (Env { functions = xs }) expr --- Compute a "+ - div * mod" list, using defines if needed +-- -- Compute a "+ - div * mod" list, using defines if needed -addition :: Env -> [Tree] -> (Env, Maybe Result) -addition env [Number a, Number b] = (env, Just (Number (a + b))) -addition env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a + symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -addition env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue + b))) - | otherwise = (registerError env "Symbol not found", Nothing) -addition env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA + symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -addition env list - | length list /= 2 = (registerError env "Addition need 2 params", Nothing) - | otherwise = (registerError env "Bad types in addition", Nothing) +-- addition :: Env -> [Tree] -> (Env, Maybe Result) +-- addition env [Number a, Number b] = (env, Just (Number (a + b))) +-- addition env [Number a, Symbol b] +-- | (_, Just (Number symbolValue)) <- evaluateSymbol env b = +-- (env, Just (Number (a + symbolValue))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- addition env [Symbol a, Number b] +-- | (_, Just (Number symbolValue)) <- evaluateSymbol env a = +-- (env, Just (Number (symbolValue + b))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- addition env [Symbol a, Symbol b] +-- | (_, Just (Number symbolValueA)) <- evaluateSymbol env a +-- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = +-- (env, Just (Number (symbolValueA + symbolValueB))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- addition env list +-- | length list /= 2 = (registerError env "Addition need 2 params", Nothing) +-- | otherwise = (registerError env "Bad types in addition", Nothing) -multiplication :: Env -> [Tree] -> (Env, Maybe Result) -multiplication env [Number a, Number b] = (env, Just (Number (a * b))) -multiplication env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a * symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -multiplication env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue * b))) - | otherwise = (registerError env "Symbol not found", Nothing) -multiplication env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA * symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -multiplication env list - | length list /= 2 = (registerError env "* need 2 params", Nothing) - | otherwise = (registerError env "Bad types in multiplication", Nothing) +-- multiplication :: Env -> [Tree] -> (Env, Maybe Result) +-- multiplication env [Number a, Number b] = (env, Just (Number (a * b))) +-- multiplication env [Number a, Symbol b] +-- | (_, Just (Number symbolValue)) <- evaluateSymbol env b = +-- (env, Just (Number (a * symbolValue))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- multiplication env [Symbol a, Number b] +-- | (_, Just (Number symbolValue)) <- evaluateSymbol env a = +-- (env, Just (Number (symbolValue * b))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- multiplication env [Symbol a, Symbol b] +-- | (_, Just (Number symbolValueA)) <- evaluateSymbol env a +-- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = +-- (env, Just (Number (symbolValueA * symbolValueB))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- multiplication env list +-- | length list /= 2 = (registerError env "* need 2 params", Nothing) +-- | otherwise = (registerError env "Bad types in multiplication", Nothing) -subtraction :: Env -> [Tree] -> (Env, Maybe Result) -subtraction env [Number a, Number b] = (env, Just (Number (a - b))) -subtraction env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a - symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -subtraction env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue - b))) - | otherwise = (registerError env "Symbol not found", Nothing) -subtraction env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA - symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -subtraction env list - | length list /= 2 = (registerError env "- need 2 params", Nothing) - | otherwise = (registerError env "Bad types in subtraction", Nothing) +-- subtraction :: Env -> [Tree] -> (Env, Maybe Result) +-- subtraction env [Number a, Number b] = (env, Just (Number (a - b))) +-- subtraction env [Number a, Symbol b] +-- | (_, Just (Number symbolValue)) <- evaluateSymbol env b = +-- (env, Just (Number (a - symbolValue))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- subtraction env [Symbol a, Number b] +-- | (_, Just (Number symbolValue)) <- evaluateSymbol env a = +-- (env, Just (Number (symbolValue - b))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- subtraction env [Symbol a, Symbol b] +-- | (_, Just (Number symbolValueA)) <- evaluateSymbol env a +-- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = +-- (env, Just (Number (symbolValueA - symbolValueB))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- subtraction env list +-- | length list /= 2 = (registerError env "- need 2 params", Nothing) +-- | otherwise = (registerError env "Bad types in subtraction", Nothing) -division :: Env -> [Tree] -> (Env, Maybe Result) -division env [Number a, Number b] - | b == 0 = (registerError env "Division by 0", Nothing) - | otherwise = (env, Just (Number (a `div` b))) -division env [Symbol a, Number b] - | b == 0 = (registerError env "Division by 0", Nothing) - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue `div` b))) - | otherwise = (registerError env "Symbol not found", Nothing) -division env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b - , symbolValue == 0 = (registerError env "Division by 0", Nothing) - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a `div` symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -division env [Symbol a, Symbol b] - | (_, Just (Number _)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b - , symbolValueB == 0 = (registerError env "Division by 0", Nothing) - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA `div` symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -division env list - | length list /= 2 = (registerError env "/ need 2 params", Nothing) - | otherwise = (registerError env "Bad types in division", Nothing) +-- division :: Env -> [Tree] -> (Env, Maybe Result) +-- division env [Number a, Number b] +-- | b == 0 = (registerError env "Division by 0", Nothing) +-- | otherwise = (env, Just (Number (a `div` b))) +-- division env [Symbol a, Number b] +-- | b == 0 = (registerError env "Division by 0", Nothing) +-- | (_, Just (Number symbolValue)) <- evaluateSymbol env a = +-- (env, Just (Number (symbolValue `div` b))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- division env [Number a, Symbol b] +-- | (_, Just (Number symbolValue)) <- evaluateSymbol env b +-- , symbolValue == 0 = (registerError env "Division by 0", Nothing) +-- | (_, Just (Number symbolValue)) <- evaluateSymbol env b = +-- (env, Just (Number (a `div` symbolValue))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- division env [Symbol a, Symbol b] +-- | (_, Just (Number _)) <- evaluateSymbol env a +-- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b +-- , symbolValueB == 0 = (registerError env "Division by 0", Nothing) +-- | (_, Just (Number symbolValueA)) <- evaluateSymbol env a +-- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = +-- (env, Just (Number (symbolValueA `div` symbolValueB))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- division env list +-- | length list /= 2 = (registerError env "/ need 2 params", Nothing) +-- | otherwise = (registerError env "Bad types in division", Nothing) -modulo :: Env -> [Tree] -> (Env, Maybe Result) -modulo env [Number a, Number b] - | b == 0 = (registerError env "Modulo by 0", Nothing) - | otherwise = (env, Just (Number (a `mod` b))) -modulo env [Symbol a, Number b] - | b == 0 = (registerError env "Modulo by 0", Nothing) - | (_, Just (Number symbolValue)) <- getSymbolValue env a = - (env, Just (Number (symbolValue `mod` b))) - | otherwise = (registerError env "Symbol not found", Nothing) -modulo env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- getSymbolValue env b - , symbolValue == 0 = (registerError env "Modulo by 0", Nothing) - | (_, Just (Number symbolValue)) <- getSymbolValue env b = - (env, Just (Number (a `mod` symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) -modulo env [Symbol a, Symbol b] - | (_, Just (Number _)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b - , symbolValueB == 0 = (registerError env "Modulo by 0", Nothing) - | (_, Just (Number symbolValueA)) <- getSymbolValue env a - , (_, Just (Number symbolValueB)) <- getSymbolValue env b = - (env, Just (Number (symbolValueA `mod` symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) -modulo env list - | length list /= 2 = (registerError env "% need 2 params", Nothing) - | otherwise = (registerError env "Bad types in modulo", Nothing) +-- modulo :: Env -> [Tree] -> (Env, Maybe Result) +-- modulo env [Number a, Number b] +-- | b == 0 = (registerError env "Modulo by 0", Nothing) +-- | otherwise = (env, Just (Number (a `mod` b))) +-- modulo env [Symbol a, Number b] +-- | b == 0 = (registerError env "Modulo by 0", Nothing) +-- | (_, Just (Number symbolValue)) <- evaluateSymbol env a = +-- (env, Just (Number (symbolValue `mod` b))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- modulo env [Number a, Symbol b] +-- | (_, Just (Number symbolValue)) <- evaluateSymbol env b +-- , symbolValue == 0 = (registerError env "Modulo by 0", Nothing) +-- | (_, Just (Number symbolValue)) <- evaluateSymbol env b = +-- (env, Just (Number (a `mod` symbolValue))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- modulo env [Symbol a, Symbol b] +-- | (_, Just (Number _)) <- evaluateSymbol env a +-- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b +-- , symbolValueB == 0 = (registerError env "Modulo by 0", Nothing) +-- | (_, Just (Number symbolValueA)) <- evaluateSymbol env a +-- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = +-- (env, Just (Number (symbolValueA `mod` symbolValueB))) +-- | otherwise = (registerError env "Symbol not found", Nothing) +-- modulo env list +-- | length list /= 2 = (registerError env "% need 2 params", Nothing) +-- | otherwise = (registerError env "Bad types in modulo", Nothing) diff --git a/test/Spec.hs b/test/Spec.hs index a9346a8..ff3cf59 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -146,6 +146,10 @@ unitTestsComputeDefines = testGroup "Tests Compute defines" assertEqual "define x (42 + 6); x" (Env {defines = [Define {symbol = "x", expression = List [Symbol "+", Number 42, Number 6]}], errors = [], functions = []}, [Just (Number 48)]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", (List [Symbol "+", Number 42, Number 6])]), (Symbol "x")]) + , testCase "define foo (4 + 5); foo + foo" $ + assertEqual "define foo (4 + 5); foo + foo" + (Env {defines = [Define {symbol = "foo", expression = List [Symbol "+", Number 4, Number 5]}], errors = [], functions = []}, [Just (Number 18)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", (List [Symbol "+", Number 4, Number 5])]), (List [Symbol "+", Symbol "foo", Symbol "foo"])]) ] unitTestsComputeSimpleFunctions :: TestTree From 51b61b47d134172ab4f113c79bed440bd98f0933 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sat, 16 Dec 2023 07:21:44 +0100 Subject: [PATCH 14/40] Fix warnings --- src/ComputeAST.hs | 30 ++++++++++++++---------------- src/Defines.hs | 8 +++++--- src/ReplaceFunctionParams.hs | 6 +++--- 3 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index a575ad9..0deb3f9 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -16,16 +16,15 @@ import ListContainList import Defines import Errors import ReplaceFunctionParams -import Functions -- Find and execute user defined function getFunctionByName :: Env -> String -> Maybe Function getFunctionByName (Env { functions = [] }) _ = Nothing -getFunctionByName (Env { functions = (Function name params body):xs }) expr - | name == expr = Just (Function name params body) - | otherwise = getFunctionByName (Env { functions = xs }) expr +getFunctionByName (Env { functions = (Function fnName fnParams body):xs, defines = defs, errors = errs }) expr + | fnName == expr = Just (Function fnName fnParams body) + | otherwise = getFunctionByName (Env { functions = xs, defines = defs, errors = errs }) expr -- Compute a "+ - div * mod" list, using defines if needed @@ -179,7 +178,7 @@ handleSimpleList env (Symbol "mod" : rest) = modulo env rest handleSimpleList env (Symbol smbl : rest) = case getFunctionByName env smbl of Just func -> - let (newEnv, result) = computeFunction env func rest + let (_, result) = computeFunction env func rest in case result of Just res -> (env, Just res) Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) @@ -196,25 +195,24 @@ handleDeepList env list (newEnv, Just resolvedList) -> handleDeepList newEnv resolvedList handleLambda :: Env -> Tree -> (Env, Maybe Result) -handleLambda env (List (List (Symbol "lambda" : List params : bodies): (List args): _)) - = computeFunction env (Function "" (getParams (List params)) bodies) args +handleLambda env (List (List (Symbol "lambda" : List fnParams : fnBodies): (List args): _)) + = computeFunction env (Function "" (getParams (List fnParams)) fnBodies) args handleLambda env _ = (registerError env "Bad lambda", Nothing) computeFunction' :: Env -> Function -> [Tree] -> (Env, Maybe Result) computeFunction' env (Function _ _ []) _ = (env, Nothing) -computeFunction' env (Function name params (x:_)) args = - case replaceFunctionParams env params x args of +computeFunction' env (Function _ fnParams (x:_)) args = + case replaceFunctionParams env fnParams x args of (newEnv, Nothing) -> (newEnv, Nothing) (newEnv, Just replaced) -> computeAST newEnv replaced computeFunction :: Env -> Function -> [Tree] -> (Env, Maybe Result) -computeFunction env (Function _ _ []) _ = (env, Nothing) -computeFunction env (Function name params (x:xs:rest)) args = - case computeFunction' env (Function name params [x]) args of - (newEnv, Nothing) -> computeFunction newEnv (Function name params (xs:rest)) args - (newEnv, Just replaced) -> (registerError newEnv "Return needs to be the last statement", Nothing) -computeFunction env (Function name params (x:_)) args = - case computeFunction' env (Function name params [x]) args of +computeFunction env (Function fnName fnParams (x:xs:rest)) args = + case computeFunction' env (Function fnName fnParams [x]) args of + (newEnv, Nothing) -> computeFunction newEnv (Function fnName fnParams (xs:rest)) args + (newEnv, Just _) -> (registerError newEnv "Return needs to be the last statement", Nothing) +computeFunction env (Function fnName fnParams (x:_)) args = + case computeFunction' env (Function fnName fnParams [x]) args of (newEnv, Nothing) -> (registerError newEnv "Missing return in function", Nothing) (newEnv, Just replaced) -> computeAST newEnv replaced computeFunction env _ _ = (registerError env "Bad function call", Nothing) diff --git a/src/Defines.hs b/src/Defines.hs index c303590..82634b2 100644 --- a/src/Defines.hs +++ b/src/Defines.hs @@ -31,7 +31,8 @@ registerDefine env symb value = -- Add a function to the Functions list in the Env addFunction :: Env -> String -> [String] -> [Tree] -> Env -addFunction env name params bodies = Env (defines env) (errors env) (functions env ++ [Function name params bodies]) +addFunction env fnName fnParams fnBodies + = Env (defines env) (errors env) (functions env ++ [Function fnName fnParams fnBodies]) -- Get params from a function getParams :: Tree -> [String] @@ -42,9 +43,10 @@ getParams _ = [] -- Register a function in the Functions list registerFunction :: Env -> Symbol -> Tree -> [Tree] -> Env registerFunction env "" _ _ = registerError env "function name must not be empty" -registerFunction env name params bodies = addFunction env name (getParams params) bodies +registerFunction env fnName fnParams fnBodies + = addFunction env fnName (getParams fnParams) fnBodies handleDefine :: Env -> Tree -> (Env, Maybe Result) -handleDefine env (List [Symbol _, Symbol smbl, List (Symbol "lambda": List params : bodies)]) = (registerFunction env smbl (List params) bodies, Nothing) +handleDefine env (List [Symbol _, Symbol smbl, List (Symbol "lambda": List fnParams : fnBodies)]) = (registerFunction env smbl (List fnParams) fnBodies, Nothing) handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl expr, Nothing) handleDefine env _ = (registerError env "Bad define", Nothing) diff --git a/src/ReplaceFunctionParams.hs b/src/ReplaceFunctionParams.hs index 848a3c6..7ca27e6 100644 --- a/src/ReplaceFunctionParams.hs +++ b/src/ReplaceFunctionParams.hs @@ -13,9 +13,9 @@ replaceSymbol (List lst) toReplace with = replaceSymbol t _ _ = t replaceFunctionParams :: Env -> [String] -> Tree -> [Tree] -> (Env, Maybe Tree) -replaceFunctionParams env params body args - | length params /= length args = (registerError env "Mismatched number of arguments", Nothing) +replaceFunctionParams env fnParams body args + | length fnParams /= length args = (registerError env "Mismatched number of arguments", Nothing) | otherwise = - let replacement = zip params args + let replacement = zip fnParams args replacedbody = foldl (\acc (param, arg) -> replaceSymbol acc param arg) body replacement in (env, Just replacedbody) From df44831a9a14e809fb996433ead9dfd648f03fd2 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sat, 16 Dec 2023 07:42:51 +0100 Subject: [PATCH 15/40] Fix newenv in handleSimpleList --- src/ComputeAST.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index 0deb3f9..961431c 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -178,10 +178,10 @@ handleSimpleList env (Symbol "mod" : rest) = modulo env rest handleSimpleList env (Symbol smbl : rest) = case getFunctionByName env smbl of Just func -> - let (_, result) = computeFunction env func rest + let (newEnv, result) = computeFunction env func rest in case result of Just res -> (env, Just res) - Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) + Nothing -> (registerError newEnv ("Can't compute function " ++ smbl), Nothing) Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) handleSimpleList env _ = (registerError env "Bad function call", Nothing) From ccee1af08a0e73880dc383bcf52b10c770e335a6 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sat, 16 Dec 2023 18:36:07 +0100 Subject: [PATCH 16/40] Fix one test --- src/ComputeAST.hs | 87 +++++++++++++++------- src/Defines.hs | 3 +- src/Functions.hs | 138 ++--------------------------------- src/ReplaceFunctionParams.hs | 7 +- test/Spec.hs | 6 +- 5 files changed, 77 insertions(+), 164 deletions(-) diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index 961431c..372adcc 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -16,15 +16,7 @@ import ListContainList import Defines import Errors import ReplaceFunctionParams - - --- Find and execute user defined function - -getFunctionByName :: Env -> String -> Maybe Function -getFunctionByName (Env { functions = [] }) _ = Nothing -getFunctionByName (Env { functions = (Function fnName fnParams body):xs, defines = defs, errors = errs }) expr - | fnName == expr = Just (Function fnName fnParams body) - | otherwise = getFunctionByName (Env { functions = xs, defines = defs, errors = errs }) expr +import Functions -- Compute a "+ - div * mod" list, using defines if needed @@ -139,6 +131,12 @@ modulo env list | length list /= 2 = (registerError env "% need 2 params", Nothing) | otherwise = (registerError env "Bad types in modulo", Nothing) + + +---------------------------------------------------------------------------------- + + + evaluateSymbol :: Env -> Symbol -> (Env, Maybe Tree) evaluateSymbol env smbl = case getSymbolValue env smbl of @@ -148,6 +146,12 @@ evaluateSymbol env smbl = (_, Just (List list)) -> computeAST env (List list) (_, _) -> (env, Nothing) + + +---------------------------------------------------------------------------------- + + + -- Find nested lists and resolve them resolveNestedLists :: Env -> [Tree] -> [Tree] -> (Env, Maybe [Tree]) resolveNestedLists env resolvedList [] = (env, Just resolvedList) @@ -168,7 +172,19 @@ resolveNestedLists env resolvedList (Boolean value : rest) = resolveNestedLists env resolvedList (Symbol smbl : rest) = resolveNestedLists env (resolvedList ++ [Symbol smbl]) rest - -- Compute simple lists (no nested lists) + + + + + + +---------------------------------------------------------------------------------- + + + + + +-- Compute simple lists (no nested lists) handleSimpleList :: Env -> [Tree] -> (Env, Maybe Result) handleSimpleList env (Symbol "+" : rest) = addition env rest handleSimpleList env (Symbol "*" : rest) = multiplication env rest @@ -177,12 +193,11 @@ handleSimpleList env (Symbol "div" : rest) = division env rest handleSimpleList env (Symbol "mod" : rest) = modulo env rest handleSimpleList env (Symbol smbl : rest) = case getFunctionByName env smbl of + Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) Just func -> - let (newEnv, result) = computeFunction env func rest - in case result of - Just res -> (env, Just res) - Nothing -> (registerError newEnv ("Can't compute function " ++ smbl), Nothing) - Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) + case computeFunction env func rest of + (_, Just res) -> (env, Just res) + (newEnv, Nothing) -> (env { errors = errors newEnv }, Nothing) handleSimpleList env _ = (registerError env "Bad function call", Nothing) -- Compute nested lists @@ -194,39 +209,55 @@ handleDeepList env list (newEnv, Nothing) -> (newEnv, Nothing) (newEnv, Just resolvedList) -> handleDeepList newEnv resolvedList + +---------------------------------------------------------------------------------- + + handleLambda :: Env -> Tree -> (Env, Maybe Result) handleLambda env (List (List (Symbol "lambda" : List fnParams : fnBodies): (List args): _)) = computeFunction env (Function "" (getParams (List fnParams)) fnBodies) args handleLambda env _ = (registerError env "Bad lambda", Nothing) -computeFunction' :: Env -> Function -> [Tree] -> (Env, Maybe Result) -computeFunction' env (Function _ _ []) _ = (env, Nothing) -computeFunction' env (Function _ fnParams (x:_)) args = + + +------------------------------------------------------------------------------------- + + + +computeFunctionBody :: Env -> Function -> [Tree] -> (Env, Maybe Result) +computeFunctionBody env (Function _ _ []) _ = (env, Nothing) +computeFunctionBody env (Function _ fnParams (x:_)) args = case replaceFunctionParams env fnParams x args of (newEnv, Nothing) -> (newEnv, Nothing) (newEnv, Just replaced) -> computeAST newEnv replaced computeFunction :: Env -> Function -> [Tree] -> (Env, Maybe Result) computeFunction env (Function fnName fnParams (x:xs:rest)) args = - case computeFunction' env (Function fnName fnParams [x]) args of + case computeFunctionBody env (Function fnName fnParams [x]) args of (newEnv, Nothing) -> computeFunction newEnv (Function fnName fnParams (xs:rest)) args - (newEnv, Just _) -> (registerError newEnv "Return needs to be the last statement", Nothing) + (_, Just _) -> (registerError env "Return needs to be the last statement", Nothing) computeFunction env (Function fnName fnParams (x:_)) args = - case computeFunction' env (Function fnName fnParams [x]) args of + case computeFunctionBody env (Function fnName fnParams [x]) args of (newEnv, Nothing) -> (registerError newEnv "Missing return in function", Nothing) (newEnv, Just replaced) -> computeAST newEnv replaced computeFunction env _ _ = (registerError env "Bad function call", Nothing) --- Handle AST that doesn't contain a list -handleNoList :: Env -> Tree -> (Env, Maybe Result) -handleNoList env (Number nbr) = (env, Just (Number nbr)) -handleNoList env (Boolean value) = (env, Just (Boolean value)) -handleNoList env (Symbol smbl) + + +------------------------------------------------------------------------------------- + + + +-- Compute AST that doesn't contain a list +computeASTWithoutList :: Env -> Tree -> (Env, Maybe Result) +computeASTWithoutList env (Number nbr) = (env, Just (Number nbr)) +computeASTWithoutList env (Boolean value) = (env, Just (Boolean value)) +computeASTWithoutList env (Symbol smbl) | Nothing <- value = (env, Nothing) | Just (List list) <- value = computeAST env (List list) | Just result <- value = (env, Just result) where (_, value) = getSymbolValue env smbl -handleNoList env _ = (env, Nothing) +computeASTWithoutList env _ = (env, Nothing) -- Compute entire AST computeAST :: Env -> Tree -> (Env, Maybe Result) @@ -235,4 +266,4 @@ computeAST env tree@(List (List (Symbol "lambda" : _) : _)) = handleLambda env t computeAST env (List list) | doesListContainsList list = handleDeepList env list | otherwise = handleSimpleList env list -computeAST env tree = handleNoList env tree +computeAST env tree = computeASTWithoutList env tree diff --git a/src/Defines.hs b/src/Defines.hs index 82634b2..5fa54cb 100644 --- a/src/Defines.hs +++ b/src/Defines.hs @@ -47,6 +47,7 @@ registerFunction env fnName fnParams fnBodies = addFunction env fnName (getParams fnParams) fnBodies handleDefine :: Env -> Tree -> (Env, Maybe Result) -handleDefine env (List [Symbol _, Symbol smbl, List (Symbol "lambda": List fnParams : fnBodies)]) = (registerFunction env smbl (List fnParams) fnBodies, Nothing) +handleDefine env (List [Symbol _, Symbol smbl, List (Symbol "lambda": List fnParams : fnBodies)]) + = (registerFunction env smbl (List fnParams) fnBodies, Nothing) handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl expr, Nothing) handleDefine env _ = (registerError env "Bad define", Nothing) diff --git a/src/Functions.hs b/src/Functions.hs index c7d8260..01023bf 100644 --- a/src/Functions.hs +++ b/src/Functions.hs @@ -6,136 +6,14 @@ -} module Functions - ( --- getFunctionByName, --- addition, --- multiplication, --- subtraction, --- division, --- modulo + ( getFunctionByName ) where --- import Types --- import Errors --- import Defines +import Types --- -- Find and execute user defined function - --- getFunctionByName :: Env -> String -> Maybe Function --- getFunctionByName (Env { functions = [] }) _ = Nothing --- getFunctionByName (Env { functions = (Function name params body):xs }) expr --- | name == expr = Just (Function name params body) --- | otherwise = getFunctionByName (Env { functions = xs }) expr - --- -- Compute a "+ - div * mod" list, using defines if needed - --- addition :: Env -> [Tree] -> (Env, Maybe Result) --- addition env [Number a, Number b] = (env, Just (Number (a + b))) --- addition env [Number a, Symbol b] --- | (_, Just (Number symbolValue)) <- evaluateSymbol env b = --- (env, Just (Number (a + symbolValue))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- addition env [Symbol a, Number b] --- | (_, Just (Number symbolValue)) <- evaluateSymbol env a = --- (env, Just (Number (symbolValue + b))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- addition env [Symbol a, Symbol b] --- | (_, Just (Number symbolValueA)) <- evaluateSymbol env a --- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = --- (env, Just (Number (symbolValueA + symbolValueB))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- addition env list --- | length list /= 2 = (registerError env "Addition need 2 params", Nothing) --- | otherwise = (registerError env "Bad types in addition", Nothing) - --- multiplication :: Env -> [Tree] -> (Env, Maybe Result) --- multiplication env [Number a, Number b] = (env, Just (Number (a * b))) --- multiplication env [Number a, Symbol b] --- | (_, Just (Number symbolValue)) <- evaluateSymbol env b = --- (env, Just (Number (a * symbolValue))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- multiplication env [Symbol a, Number b] --- | (_, Just (Number symbolValue)) <- evaluateSymbol env a = --- (env, Just (Number (symbolValue * b))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- multiplication env [Symbol a, Symbol b] --- | (_, Just (Number symbolValueA)) <- evaluateSymbol env a --- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = --- (env, Just (Number (symbolValueA * symbolValueB))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- multiplication env list --- | length list /= 2 = (registerError env "* need 2 params", Nothing) --- | otherwise = (registerError env "Bad types in multiplication", Nothing) - --- subtraction :: Env -> [Tree] -> (Env, Maybe Result) --- subtraction env [Number a, Number b] = (env, Just (Number (a - b))) --- subtraction env [Number a, Symbol b] --- | (_, Just (Number symbolValue)) <- evaluateSymbol env b = --- (env, Just (Number (a - symbolValue))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- subtraction env [Symbol a, Number b] --- | (_, Just (Number symbolValue)) <- evaluateSymbol env a = --- (env, Just (Number (symbolValue - b))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- subtraction env [Symbol a, Symbol b] --- | (_, Just (Number symbolValueA)) <- evaluateSymbol env a --- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = --- (env, Just (Number (symbolValueA - symbolValueB))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- subtraction env list --- | length list /= 2 = (registerError env "- need 2 params", Nothing) --- | otherwise = (registerError env "Bad types in subtraction", Nothing) - --- division :: Env -> [Tree] -> (Env, Maybe Result) --- division env [Number a, Number b] --- | b == 0 = (registerError env "Division by 0", Nothing) --- | otherwise = (env, Just (Number (a `div` b))) --- division env [Symbol a, Number b] --- | b == 0 = (registerError env "Division by 0", Nothing) --- | (_, Just (Number symbolValue)) <- evaluateSymbol env a = --- (env, Just (Number (symbolValue `div` b))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- division env [Number a, Symbol b] --- | (_, Just (Number symbolValue)) <- evaluateSymbol env b --- , symbolValue == 0 = (registerError env "Division by 0", Nothing) --- | (_, Just (Number symbolValue)) <- evaluateSymbol env b = --- (env, Just (Number (a `div` symbolValue))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- division env [Symbol a, Symbol b] --- | (_, Just (Number _)) <- evaluateSymbol env a --- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b --- , symbolValueB == 0 = (registerError env "Division by 0", Nothing) --- | (_, Just (Number symbolValueA)) <- evaluateSymbol env a --- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = --- (env, Just (Number (symbolValueA `div` symbolValueB))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- division env list --- | length list /= 2 = (registerError env "/ need 2 params", Nothing) --- | otherwise = (registerError env "Bad types in division", Nothing) - --- modulo :: Env -> [Tree] -> (Env, Maybe Result) --- modulo env [Number a, Number b] --- | b == 0 = (registerError env "Modulo by 0", Nothing) --- | otherwise = (env, Just (Number (a `mod` b))) --- modulo env [Symbol a, Number b] --- | b == 0 = (registerError env "Modulo by 0", Nothing) --- | (_, Just (Number symbolValue)) <- evaluateSymbol env a = --- (env, Just (Number (symbolValue `mod` b))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- modulo env [Number a, Symbol b] --- | (_, Just (Number symbolValue)) <- evaluateSymbol env b --- , symbolValue == 0 = (registerError env "Modulo by 0", Nothing) --- | (_, Just (Number symbolValue)) <- evaluateSymbol env b = --- (env, Just (Number (a `mod` symbolValue))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- modulo env [Symbol a, Symbol b] --- | (_, Just (Number _)) <- evaluateSymbol env a --- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b --- , symbolValueB == 0 = (registerError env "Modulo by 0", Nothing) --- | (_, Just (Number symbolValueA)) <- evaluateSymbol env a --- , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = --- (env, Just (Number (symbolValueA `mod` symbolValueB))) --- | otherwise = (registerError env "Symbol not found", Nothing) --- modulo env list --- | length list /= 2 = (registerError env "% need 2 params", Nothing) --- | otherwise = (registerError env "Bad types in modulo", Nothing) +-- Find and execute user defined function +getFunctionByName :: Env -> String -> Maybe Function +getFunctionByName (Env { functions = [] }) _ = Nothing +getFunctionByName (Env { functions = (Function fnName fnParams body):xs, defines = defs, errors = errs }) expr + | fnName == expr = Just (Function fnName fnParams body) + | otherwise = getFunctionByName (Env { functions = xs, defines = defs, errors = errs }) expr diff --git a/src/ReplaceFunctionParams.hs b/src/ReplaceFunctionParams.hs index 7ca27e6..565c675 100644 --- a/src/ReplaceFunctionParams.hs +++ b/src/ReplaceFunctionParams.hs @@ -8,8 +8,11 @@ import Types import Errors replaceSymbol :: Tree -> String -> Tree -> Tree -replaceSymbol (List lst) toReplace with = - List (map (\t -> if t == Symbol toReplace then with else replaceSymbol t toReplace with) lst) +replaceSymbol (Symbol smbl) toReplace replacement + | smbl == toReplace = replacement + | otherwise = Symbol smbl +replaceSymbol (List lst) toReplace replacement + = List (map (\t -> replaceSymbol t toReplace replacement) lst) replaceSymbol t _ _ = t replaceFunctionParams :: Env -> [String] -> Tree -> [Tree] -> (Env, Maybe Tree) diff --git a/test/Spec.hs b/test/Spec.hs index ff3cf59..0fa68a5 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -228,10 +228,10 @@ unitTestsComputeFunctions = testGroup "Tests compute functions" (computeAST (Env {defines = [], errors = [], functions = []}) (List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number 2]])) , testCase "(define func (lambda () (define foo 42) (foo))); (func)" $ assertEqual "(define func (lambda () (define foo 42) (foo))); (func)" - (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "define", Symbol "foo", Symbol "42"], Symbol "foo"]}]}, [Just (Number 42)]) + (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "define", Symbol "foo", Number 42], Symbol "foo"]}]}, [Just (Number 42)]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "define", Symbol "foo", Symbol "42"], Symbol "foo"]]), (List [Symbol "func"])]) , testCase "(define func (lambda () (+ 42 42))); (func)" $ assertEqual "(define func (lambda () (+ 42 42))); (func)" - (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "+", Symbol "42", Symbol "42"]]}]}, [Just (Number 84)]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "+", Symbol "42", Symbol "42"]]]), (List [Symbol "func"])]) + (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "+", Number 42, Number 42]]}]}, [Just (Number 84)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "+", Number 42, Number 42]]]), (List [Symbol "func"])]) ] From adb738de0bf02c3e24372f36855262a820949fee Mon Sep 17 00:00:00 2001 From: tenshi Date: Sat, 16 Dec 2023 18:42:58 +0100 Subject: [PATCH 17/40] add more tests --- test/Spec.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index 0fa68a5..9519f40 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -229,9 +229,13 @@ unitTestsComputeFunctions = testGroup "Tests compute functions" , testCase "(define func (lambda () (define foo 42) (foo))); (func)" $ assertEqual "(define func (lambda () (define foo 42) (foo))); (func)" (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "define", Symbol "foo", Number 42], Symbol "foo"]}]}, [Just (Number 42)]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "define", Symbol "foo", Symbol "42"], Symbol "foo"]]), (List [Symbol "func"])]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "define", Symbol "foo", Number 42], Symbol "foo"]]), (List [Symbol "func"])]) , testCase "(define func (lambda () (+ 42 42))); (func)" $ assertEqual "(define func (lambda () (+ 42 42))); (func)" (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "+", Number 42, Number 42]]}]}, [Just (Number 84)]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "+", Number 42, Number 42]]]), (List [Symbol "func"])]) + , testCase "(define func (lambda (x) (+ 1 x))); (func 41)" $ + assertEqual "(define func (lambda (x) (+ 1 x))); (func 41)" + (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["x"], bodies = [List [Symbol "+", Number 1, Symbol "x"]]}]}, [Just (Number 42)]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "x"], List [Symbol "+", Number 1, Symbol "x"]]]), (List [Symbol "func", Number 41])]) ] From 8b7267f0c76a7b5c338ba524a7c98584e0cac7ec Mon Sep 17 00:00:00 2001 From: tenshi Date: Sat, 16 Dec 2023 20:19:12 +0100 Subject: [PATCH 18/40] Change result type MINOR --- src/ComputeAST.hs | 175 +++++++++++++++++++++++----------------------- src/Defines.hs | 8 +-- src/Types.hs | 4 +- test/Spec.hs | 77 +++++++++++--------- 4 files changed, 140 insertions(+), 124 deletions(-) diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index 372adcc..22b64ae 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -20,116 +20,116 @@ import Functions -- Compute a "+ - div * mod" list, using defines if needed -addition :: Env -> [Tree] -> (Env, Maybe Result) -addition env [Number a, Number b] = (env, Just (Number (a + b))) +addition :: Env -> [Tree] -> (Env, Result) +addition env [Number a, Number b] = (env, Left (Just (Number (a + b)))) addition env [Number a, Symbol b] | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Just (Number (a + symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (a + symbolValue)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) addition env [Symbol a, Number b] | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Just (Number (symbolValue + b))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (symbolValue + b)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) addition env [Symbol a, Symbol b] | (_, Just (Number symbolValueA)) <- evaluateSymbol env a , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Just (Number (symbolValueA + symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (symbolValueA + symbolValueB)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) addition env list - | length list /= 2 = (registerError env "Addition need 2 params", Nothing) - | otherwise = (registerError env "Bad types in addition", Nothing) + | length list /= 2 = (registerError env "Addition need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in addition", Right (undefined)) -multiplication :: Env -> [Tree] -> (Env, Maybe Result) -multiplication env [Number a, Number b] = (env, Just (Number (a * b))) +multiplication :: Env -> [Tree] -> (Env, Result) +multiplication env [Number a, Number b] = (env, Left (Just (Number (a * b)))) multiplication env [Number a, Symbol b] | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Just (Number (a * symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left(Just (Number (a * symbolValue)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) multiplication env [Symbol a, Number b] | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Just (Number (symbolValue * b))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (symbolValue * b)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) multiplication env [Symbol a, Symbol b] | (_, Just (Number symbolValueA)) <- evaluateSymbol env a , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Just (Number (symbolValueA * symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (symbolValueA * symbolValueB)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) multiplication env list - | length list /= 2 = (registerError env "* need 2 params", Nothing) - | otherwise = (registerError env "Bad types in multiplication", Nothing) + | length list /= 2 = (registerError env "* need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in multiplication", Right (undefined)) -subtraction :: Env -> [Tree] -> (Env, Maybe Result) -subtraction env [Number a, Number b] = (env, Just (Number (a - b))) +subtraction :: Env -> [Tree] -> (Env, Result) +subtraction env [Number a, Number b] = (env, Left (Just (Number (a - b)))) subtraction env [Number a, Symbol b] | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Just (Number (a - symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (a - symbolValue)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) subtraction env [Symbol a, Number b] | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Just (Number (symbolValue - b))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (symbolValue - b)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) subtraction env [Symbol a, Symbol b] | (_, Just (Number symbolValueA)) <- evaluateSymbol env a , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Just (Number (symbolValueA - symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (symbolValueA - symbolValueB)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) subtraction env list - | length list /= 2 = (registerError env "- need 2 params", Nothing) - | otherwise = (registerError env "Bad types in subtraction", Nothing) + | length list /= 2 = (registerError env "- need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in subtraction", Right (undefined)) -division :: Env -> [Tree] -> (Env, Maybe Result) +division :: Env -> [Tree] -> (Env, Result) division env [Number a, Number b] - | b == 0 = (registerError env "Division by 0", Nothing) - | otherwise = (env, Just (Number (a `div` b))) + | b == 0 = (registerError env "Division by 0", Right (undefined)) + | otherwise = (env, Left (Just (Number (a `div` b)))) division env [Symbol a, Number b] - | b == 0 = (registerError env "Division by 0", Nothing) + | b == 0 = (registerError env "Division by 0", Right (undefined)) | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Just (Number (symbolValue `div` b))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (symbolValue `div` b)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) division env [Number a, Symbol b] | (_, Just (Number symbolValue)) <- evaluateSymbol env b - , symbolValue == 0 = (registerError env "Division by 0", Nothing) + , symbolValue == 0 = (registerError env "Division by 0", Right (undefined)) | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Just (Number (a `div` symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (a `div` symbolValue)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) division env [Symbol a, Symbol b] | (_, Just (Number _)) <- evaluateSymbol env a , (_, Just (Number symbolValueB)) <- evaluateSymbol env b - , symbolValueB == 0 = (registerError env "Division by 0", Nothing) + , symbolValueB == 0 = (registerError env "Division by 0", Right (undefined)) | (_, Just (Number symbolValueA)) <- evaluateSymbol env a , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Just (Number (symbolValueA `div` symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (symbolValueA `div` symbolValueB)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) division env list - | length list /= 2 = (registerError env "/ need 2 params", Nothing) - | otherwise = (registerError env "Bad types in division", Nothing) + | length list /= 2 = (registerError env "/ need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in division", Right (undefined)) -modulo :: Env -> [Tree] -> (Env, Maybe Result) +modulo :: Env -> [Tree] -> (Env, Result) modulo env [Number a, Number b] - | b == 0 = (registerError env "Modulo by 0", Nothing) - | otherwise = (env, Just (Number (a `mod` b))) + | b == 0 = (registerError env "Modulo by 0", Right (undefined)) + | otherwise = (env, Left (Just (Number (a `mod` b)))) modulo env [Symbol a, Number b] - | b == 0 = (registerError env "Modulo by 0", Nothing) + | b == 0 = (registerError env "Modulo by 0", Right (undefined)) | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Just (Number (symbolValue `mod` b))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (symbolValue `mod` b)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) modulo env [Number a, Symbol b] | (_, Just (Number symbolValue)) <- evaluateSymbol env b - , symbolValue == 0 = (registerError env "Modulo by 0", Nothing) + , symbolValue == 0 = (registerError env "Modulo by 0", Right (undefined)) | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Just (Number (a `mod` symbolValue))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (a `mod` symbolValue)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) modulo env [Symbol a, Symbol b] | (_, Just (Number _)) <- evaluateSymbol env a , (_, Just (Number symbolValueB)) <- evaluateSymbol env b - , symbolValueB == 0 = (registerError env "Modulo by 0", Nothing) + , symbolValueB == 0 = (registerError env "Modulo by 0", Right (undefined)) | (_, Just (Number symbolValueA)) <- evaluateSymbol env a , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Just (Number (symbolValueA `mod` symbolValueB))) - | otherwise = (registerError env "Symbol not found", Nothing) + (env, Left (Just (Number (symbolValueA `mod` symbolValueB)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) modulo env list - | length list /= 2 = (registerError env "% need 2 params", Nothing) - | otherwise = (registerError env "Bad types in modulo", Nothing) + | length list /= 2 = (registerError env "% need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in modulo", Right (undefined)) @@ -143,7 +143,10 @@ evaluateSymbol env smbl = (_, Nothing) -> (env, Nothing) (_, Just (Number number)) -> (env, Just (Number number)) (_, Just (Boolean value)) -> (env, Just (Boolean value)) - (_, Just (List list)) -> computeAST env (List list) + (_, Just (List list)) -> + case computeAST env (List list) of + (_, Left (Just result)) -> (env, Just result) + (_, _) -> (env, Nothing) (_, _) -> (env, Nothing) @@ -158,9 +161,9 @@ resolveNestedLists env resolvedList [] = (env, Just resolvedList) resolveNestedLists env resolvedList (List list : rest) | not (doesListContainsList list) = case handleSimpleList env list of - (newEnv, Nothing) -> (newEnv, Nothing) - (newEnv, Just resolved) -> + (newEnv, Left (Just resolved)) -> resolveNestedLists newEnv (resolvedList ++ [resolved]) rest + (newEnv, _) -> (newEnv, Nothing) | otherwise = case resolveNestedLists env [] list of (newEnv, Nothing) -> (newEnv, Nothing) (newEnv, Just rvd) @@ -185,7 +188,7 @@ resolveNestedLists env resolvedList (Symbol smbl : rest) = -- Compute simple lists (no nested lists) -handleSimpleList :: Env -> [Tree] -> (Env, Maybe Result) +handleSimpleList :: Env -> [Tree] -> (Env, Result) handleSimpleList env (Symbol "+" : rest) = addition env rest handleSimpleList env (Symbol "*" : rest) = multiplication env rest handleSimpleList env (Symbol "-" : rest) = subtraction env rest @@ -193,30 +196,30 @@ handleSimpleList env (Symbol "div" : rest) = division env rest handleSimpleList env (Symbol "mod" : rest) = modulo env rest handleSimpleList env (Symbol smbl : rest) = case getFunctionByName env smbl of - Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Nothing) + Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Right (undefined)) Just func -> case computeFunction env func rest of - (_, Just res) -> (env, Just res) - (newEnv, Nothing) -> (env { errors = errors newEnv }, Nothing) -handleSimpleList env _ = (registerError env "Bad function call", Nothing) + (_, Left (Just result)) -> (env, Left (Just result)) + (newEnv, _) -> (env { errors = errors newEnv }, Right (undefined)) +handleSimpleList env _ = (registerError env "Bad function call", Right (undefined)) -- Compute nested lists -handleDeepList :: Env -> [Tree] -> (Env, Maybe Result) +handleDeepList :: Env -> [Tree] -> (Env, Result) handleDeepList env list | not (doesListContainsList list) = handleSimpleList env list | otherwise = case resolveNestedLists env [] list of - (newEnv, Nothing) -> (newEnv, Nothing) + (newEnv, Nothing) -> (newEnv, Right (undefined)) (newEnv, Just resolvedList) -> handleDeepList newEnv resolvedList ---------------------------------------------------------------------------------- -handleLambda :: Env -> Tree -> (Env, Maybe Result) +handleLambda :: Env -> Tree -> (Env, Result) handleLambda env (List (List (Symbol "lambda" : List fnParams : fnBodies): (List args): _)) = computeFunction env (Function "" (getParams (List fnParams)) fnBodies) args -handleLambda env _ = (registerError env "Bad lambda", Nothing) +handleLambda env _ = (registerError env "Bad lambda", Left (Nothing)) @@ -224,23 +227,23 @@ handleLambda env _ = (registerError env "Bad lambda", Nothing) -computeFunctionBody :: Env -> Function -> [Tree] -> (Env, Maybe Result) -computeFunctionBody env (Function _ _ []) _ = (env, Nothing) +computeFunctionBody :: Env -> Function -> [Tree] -> (Env, Result) +computeFunctionBody env (Function _ _ []) _ = (env, Left (Nothing)) computeFunctionBody env (Function _ fnParams (x:_)) args = case replaceFunctionParams env fnParams x args of - (newEnv, Nothing) -> (newEnv, Nothing) + (newEnv, Nothing) -> (newEnv, Right (undefined)) (newEnv, Just replaced) -> computeAST newEnv replaced -computeFunction :: Env -> Function -> [Tree] -> (Env, Maybe Result) +computeFunction :: Env -> Function -> [Tree] -> (Env, Result) computeFunction env (Function fnName fnParams (x:xs:rest)) args = case computeFunctionBody env (Function fnName fnParams [x]) args of - (newEnv, Nothing) -> computeFunction newEnv (Function fnName fnParams (xs:rest)) args - (_, Just _) -> (registerError env "Return needs to be the last statement", Nothing) + (newEnv, Left (Nothing)) -> computeFunction newEnv (Function fnName fnParams (xs:rest)) args + (_, _) -> (registerError env "Return needs to be the last statement", Right (undefined)) computeFunction env (Function fnName fnParams (x:_)) args = case computeFunctionBody env (Function fnName fnParams [x]) args of - (newEnv, Nothing) -> (registerError newEnv "Missing return in function", Nothing) - (newEnv, Just replaced) -> computeAST newEnv replaced -computeFunction env _ _ = (registerError env "Bad function call", Nothing) + (newEnv, Left (Just replaced)) -> computeAST newEnv replaced + (newEnv, _) -> (registerError newEnv "Missing return in function", Right (undefined)) +computeFunction env _ _ = (registerError env "Bad function call", Right (undefined)) @@ -249,18 +252,18 @@ computeFunction env _ _ = (registerError env "Bad function call", Nothing) -- Compute AST that doesn't contain a list -computeASTWithoutList :: Env -> Tree -> (Env, Maybe Result) -computeASTWithoutList env (Number nbr) = (env, Just (Number nbr)) -computeASTWithoutList env (Boolean value) = (env, Just (Boolean value)) +computeASTWithoutList :: Env -> Tree -> (Env, Result) +computeASTWithoutList env (Number nbr) = (env, Left (Just (Number nbr))) +computeASTWithoutList env (Boolean value) = (env, Left (Just (Boolean value))) computeASTWithoutList env (Symbol smbl) - | Nothing <- value = (env, Nothing) + | Nothing <- value = (env, Right (undefined)) | Just (List list) <- value = computeAST env (List list) - | Just result <- value = (env, Just result) + | Just result <- value = (env, Left (Just result)) where (_, value) = getSymbolValue env smbl -computeASTWithoutList env _ = (env, Nothing) +computeASTWithoutList env _ = (env, Right (undefined)) -- Compute entire AST -computeAST :: Env -> Tree -> (Env, Maybe Result) +computeAST :: Env -> Tree -> (Env, Result) computeAST env tree@(List (Symbol "define" : _)) = handleDefine env tree computeAST env tree@(List (List (Symbol "lambda" : _) : _)) = handleLambda env tree computeAST env (List list) diff --git a/src/Defines.hs b/src/Defines.hs index 5fa54cb..e88771d 100644 --- a/src/Defines.hs +++ b/src/Defines.hs @@ -46,8 +46,8 @@ registerFunction env "" _ _ = registerError env "function name must not be empty registerFunction env fnName fnParams fnBodies = addFunction env fnName (getParams fnParams) fnBodies -handleDefine :: Env -> Tree -> (Env, Maybe Result) +handleDefine :: Env -> Tree -> (Env, Result) handleDefine env (List [Symbol _, Symbol smbl, List (Symbol "lambda": List fnParams : fnBodies)]) - = (registerFunction env smbl (List fnParams) fnBodies, Nothing) -handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl expr, Nothing) -handleDefine env _ = (registerError env "Bad define", Nothing) + = (registerFunction env smbl (List fnParams) fnBodies, Left (Nothing)) +handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl expr, Left (Nothing)) +handleDefine env _ = (registerError env "Bad define", Right (undefined)) diff --git a/src/Types.hs b/src/Types.hs index 54b9a67..b0e2fb5 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -16,6 +16,8 @@ module Types ) where import Data.Int (Int64) +import Data.Either (Either) +import Data.Void (Void) type Symbol = String @@ -38,7 +40,7 @@ data Env = Env { functions :: [Function] } -type Result = Tree +type Result = Either (Maybe Tree) Void ---------- EQ INSTANCES ---------- diff --git a/test/Spec.hs b/test/Spec.hs index 9519f40..447a9f0 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -18,7 +18,8 @@ tests = testGroup "Tests" unitTestsComputeSimpleFunctions, unitTestsComputeBasics, unitTestsASTParse, - unitTestsComputeFunctions + unitTestsComputeFunctions, + unitTestsComputeConditions ] unitTestsASTEqual :: TestTree @@ -94,33 +95,35 @@ unitTestsASTParse = testGroup "AST Parse Tests" testParser "(do (re (mi)) 12 (re (mi)))" (List [Symbol "do", List [Symbol "re", List [Symbol "mi"]], Number 12, List [Symbol "re", List [Symbol "mi"]]]) ] -computeAllAST :: Env -> [Tree] -> (Env, [Maybe Result]) +computeAllAST :: Env -> [Tree] -> (Env, [Result]) computeAllAST env [] = (env, []) computeAllAST env (x:xs) = do let (newEnv, result) = computeAST env x case result of - Nothing -> computeAllAST newEnv xs - Just tree -> do + Left (Just r) -> do let (newEnv2, results) = computeAllAST newEnv xs - (newEnv2, [Just tree] ++ results) + (newEnv2, (Left (Just r)):results) + _ -> do + let (newEnv2, results) = computeAllAST newEnv xs + (newEnv2, results) unitTestComputeTypes :: TestTree unitTestComputeTypes = testGroup "Tests Compute Types" [ testCase "bool true" $ assertEqual "bool true" - (Env {defines = [], errors = [], functions = []}, Just (Boolean True)) + (Env {defines = [], errors = [], functions = []}, Left (Just (Boolean True))) (computeAST (Env {defines = [], errors = [], functions = []}) (Boolean True)) , testCase "bool false" $ assertEqual "bool false" - (Env {defines = [], errors = [], functions = []}, Just (Boolean False)) + (Env {defines = [], errors = [], functions = []}, Left (Just (Boolean False))) (computeAST (Env {defines = [], errors = [], functions = []}) (Boolean False)) , testCase "number 42" $ assertEqual "number 42" - (Env {defines = [], errors = [], functions = []}, Just (Number 42)) + (Env {defines = [], errors = [], functions = []}, Left (Just (Number 42))) (computeAST (Env {defines = [], errors = [], functions = []}) (Number 42)) , testCase "number -42" $ assertEqual "number -42" - (Env {defines = [], errors = [], functions = []}, Just (Number (-42))) + (Env {defines = [], errors = [], functions = []}, Left (Just (Number (-42)))) (computeAST (Env {defines = [], errors = [], functions = []}) (Number (-42))) ] @@ -128,11 +131,11 @@ unitTestsComputeDefines :: TestTree unitTestsComputeDefines = testGroup "Tests Compute defines" [ testCase "define x 42" $ assertEqual "define x 42" - (Env {defines = [Define {symbol = "x", expression = Number 42}], errors = [], functions = []}, Nothing) + (Env {defines = [Define {symbol = "x", expression = Number 42}], errors = [], functions = []}, Left (Nothing)) (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "define", Symbol "x", Number 42])) , testCase "define x 42; x" $ assertEqual "define x 42; x" - (Env {defines = [Define {symbol = "x", expression = Number 42}], errors = [], functions = []}, [Just (Number 42)]) + (Env {defines = [Define {symbol = "x", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 42))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", Number 42]), (Symbol "x")]) , testCase "define x 42; define y 84" $ assertEqual "define x 42; define y 84" @@ -140,15 +143,15 @@ unitTestsComputeDefines = testGroup "Tests Compute defines" (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84])]) , testCase "define x 42; define y 84; x; y" $ assertEqual "define x 42; define y 84; x; y" - (Env {defines = [Define {symbol = "x", expression = Number 42}, Define {symbol = "y", expression = Number 84}], errors = [], functions = []}, [Just (Number 42), Just (Number 84)]) + (Env {defines = [Define {symbol = "x", expression = Number 42}, Define {symbol = "y", expression = Number 84}], errors = [], functions = []}, [Left (Just (Number 42)), Left (Just (Number 84))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84]), (Symbol "x"), (Symbol "y")]) , testCase "define x (42 + 6); x" $ assertEqual "define x (42 + 6); x" - (Env {defines = [Define {symbol = "x", expression = List [Symbol "+", Number 42, Number 6]}], errors = [], functions = []}, [Just (Number 48)]) + (Env {defines = [Define {symbol = "x", expression = List [Symbol "+", Number 42, Number 6]}], errors = [], functions = []}, [Left (Just (Number 48))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", (List [Symbol "+", Number 42, Number 6])]), (Symbol "x")]) , testCase "define foo (4 + 5); foo + foo" $ assertEqual "define foo (4 + 5); foo + foo" - (Env {defines = [Define {symbol = "foo", expression = List [Symbol "+", Number 4, Number 5]}], errors = [], functions = []}, [Just (Number 18)]) + (Env {defines = [Define {symbol = "foo", expression = List [Symbol "+", Number 4, Number 5]}], errors = [], functions = []}, [Left (Just (Number 18))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", (List [Symbol "+", Number 4, Number 5])]), (List [Symbol "+", Symbol "foo", Symbol "foo"])]) ] @@ -156,27 +159,27 @@ unitTestsComputeSimpleFunctions :: TestTree unitTestsComputeSimpleFunctions = testGroup "Tests compute + - div mod" [ testCase "42 + 42" $ assertEqual "42 + 42" - (Env {defines = [], errors = [], functions = []}, Just (Number 84)) + (Env {defines = [], errors = [], functions = []}, Left (Just (Number 84))) (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "+", Number 42, Number 42])) , testCase "-42 + -42" $ assertEqual "-42 + -42" - (Env {defines = [], errors = [], functions = []}, Just (Number (-84))) + (Env {defines = [], errors = [], functions = []}, Left (Just (Number (-84)))) (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "+", Number (-42), Number (-42)])) , testCase "42 + dontexist" $ assertEqual "42 + dontexist" - (Env {defines = [], errors = ["Symbol not found"], functions = []}, Nothing) + (Env {defines = [], errors = ["Symbol not found"], functions = []}, Right (undefined)) (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "+", Number 42, Symbol "dontexist"])) , testCase "bool + number" $ assertEqual "bool + number" - (Env {defines = [], errors = ["Bad types in addition"], functions = []}, Nothing) + (Env {defines = [], errors = ["Bad types in addition"], functions = []}, Right (undefined)) (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "+", Boolean True, Number 42])) , testCase "20 / 2 + 3 * 5 - 10" $ assertEqual "20 / 2 + 3 * 5 - 10" - (Env {defines = [], errors = [], functions = []}, Just (Number 15)) + (Env {defines = [], errors = [], functions = []}, Left (Just (Number 15))) (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "-", (List [Symbol "+", (List [Symbol "div", Number 20, Number 2]), (List [Symbol "*", Number 3, Number 5])]), Number 10])) , testCase "11 mod 3" $ assertEqual "11 mod 3" - (Env {defines = [], errors = [], functions = []}, Just (Number 2)) + (Env {defines = [], errors = [], functions = []}, Left (Just (Number 2))) (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "mod", Number 11, Number 3])) ] @@ -184,23 +187,23 @@ unitTestsComputeBasics :: TestTree unitTestsComputeBasics = testGroup "Tests compute basics" [ testCase "define foo 42; foo + foo" $ assertEqual "define foo 42; foo + foo" - (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Just (Number 84)]) + (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 84))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "+", Symbol "foo", Symbol "foo"])]) , testCase "define foo 42; define bar 42; foo + bar" $ assertEqual "define foo 42; define bar 42; foo + bar" - (Env {defines = [Define {symbol = "foo", expression = Number 42}, Define {symbol = "bar", expression = Number 42}], errors = [], functions = []}, [Just (Number 84)]) + (Env {defines = [Define {symbol = "foo", expression = Number 42}, Define {symbol = "bar", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 84))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "define", Symbol "bar", Number 42]), (List [Symbol "+", Symbol "foo", Symbol "bar"])]) , testCase "2 + 2 * 5" $ assertEqual "2 + 2 * 5" - (Env {defines = [], errors = [], functions = []}, [Just (Number 12)]) + (Env {defines = [], errors = [], functions = []}, [Left (Just (Number 12))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 2, Number 5])])]) , testCase "2 + 2 * (foo + 10) = 106" $ assertEqual "2 + 2 * (foo + 10) = 106" - (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Just (Number 106)]) + (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 106))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "+", Number 2, (List [Symbol "*", Number 2, (List [Symbol "+", Symbol "foo", Number 10])])])]) , testCase "2 + 3 * (8 + (5* ( 2 + 3))) = 107" $ assertEqual "2 + 3 * (8 + (5* ( 2 + 3))) = 107" - (Env {defines = [], errors = [], functions = []}, [Just (Number 101)]) + (Env {defines = [], errors = [], functions = []}, [Left (Just (Number 101))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 3, (List [Symbol "+", Number 8, (List [Symbol "*", Number 5, (List [Symbol "+", Number 2, Number 3])])])])])]) ] @@ -208,34 +211,42 @@ unitTestsComputeFunctions :: TestTree unitTestsComputeFunctions = testGroup "Tests compute functions" [ testCase "(define add (lambda (a b) (+ a b))); (add 1 2)" $ assertEqual "(define add (lambda (a b) (+ a b))); (add 1 2)" - (Env {defines = [], errors = [], functions = [Function {name = "add", params = ["a", "b"], bodies = [(List [Symbol "+", Symbol "a", Symbol "b"])]}]}, [Just (Number 3)]) + (Env {defines = [], errors = [], functions = [Function {name = "add", params = ["a", "b"], bodies = [(List [Symbol "+", Symbol "a", Symbol "b"])]}]}, [Left (Just (Number 3))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "add", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "+", Symbol "a", Symbol "b"]]]), (List [Symbol "add", Number 1, Number 2])]) , testCase "(define sub (lambda (a b) (- a b))); (sub 84 42)" $ assertEqual "(define sub (lambda (a b) (- a b))); (sub 84 42)" - (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b"], bodies = [(List [Symbol "-", Symbol "a", Symbol "b"])]}]}, [Just (Number 42)]) + (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b"], bodies = [(List [Symbol "-", Symbol "a", Symbol "b"])]}]}, [Left (Just (Number 42))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "-", Symbol "a", Symbol "b"]]]), (List [Symbol "sub", Number 84, Number 42])]) , testCase "(define sub (lambda (a b c d e) (+ a (+ b (* 8 (+ d e))); (sub 84 42 1 2 3)" $ assertEqual "(define sub (lambda (a b c d e) (+ a (+ b (* 8 (+ d e))); (sub 84 42 1 2 3)" - (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b", "c", "d", "e"], bodies = [(List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])])]}]}, [Just (Number 166)]) + (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b", "c", "d", "e"], bodies = [(List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])])]}]}, [Left (Just (Number 166))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b", Symbol "c", Symbol "d", Symbol "e" ], List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])]]]), (List [Symbol "sub", Number 84, Number 42, Number 1, Number 2, Number 3])]) , testCase "(define func (lambda (a b) (define foo a) (+ foo b))); (func 1 2)" $ assertEqual "(define func (lambda (a b) (define foo a) (+ foo b))); (func 1 2)" - (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["a", "b"], bodies = [(List [Symbol "define", Symbol "foo", Symbol "a", (List [Symbol "+", Symbol "foo", Symbol "b"])])]}]}, [Just (Number 3)]) + (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["a", "b"], bodies = [(List [Symbol "define", Symbol "foo", Symbol "a", (List [Symbol "+", Symbol "foo", Symbol "b"])])]}]}, [Left (Just (Number 3))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])]) , testCase "((lambda (a b) (+ a b)) 1 2)" $ assertEqual "((lambda (a b) (+ a b)) 1 2)" - (Env {defines = [], errors = [], functions = []}, Just (Number 3)) + (Env {defines = [], errors = [], functions = []}, Left (Just (Number 3))) (computeAST (Env {defines = [], errors = [], functions = []}) (List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number 2]])) , testCase "(define func (lambda () (define foo 42) (foo))); (func)" $ assertEqual "(define func (lambda () (define foo 42) (foo))); (func)" - (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "define", Symbol "foo", Number 42], Symbol "foo"]}]}, [Just (Number 42)]) + (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "define", Symbol "foo", Number 42], Symbol "foo"]}]}, [Left (Just (Number 42))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "define", Symbol "foo", Number 42], Symbol "foo"]]), (List [Symbol "func"])]) , testCase "(define func (lambda () (+ 42 42))); (func)" $ assertEqual "(define func (lambda () (+ 42 42))); (func)" - (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "+", Number 42, Number 42]]}]}, [Just (Number 84)]) + (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "+", Number 42, Number 42]]}]}, [Left (Just (Number 84))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "+", Number 42, Number 42]]]), (List [Symbol "func"])]) , testCase "(define func (lambda (x) (+ 1 x))); (func 41)" $ assertEqual "(define func (lambda (x) (+ 1 x))); (func 41)" - (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["x"], bodies = [List [Symbol "+", Number 1, Symbol "x"]]}]}, [Just (Number 42)]) + (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["x"], bodies = [List [Symbol "+", Number 1, Symbol "x"]]}]}, [Left (Just (Number 42))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "x"], List [Symbol "+", Number 1, Symbol "x"]]]), (List [Symbol "func", Number 41])]) ] + +unitTestsComputeConditions :: TestTree +unitTestsComputeConditions = testGroup "Tests compute conditions" + [ testCase "(if #t 42 84)" $ + assertEqual "(if #t 42 84)" + (Env {defines = [], errors = [], functions = []}, Left (Just (Number 42))) + (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "if", Boolean True, Number 42, Number 84])) + ] From 260ddaf3be920e396c834775f5a8920d5afed0b8 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sat, 16 Dec 2023 20:31:02 +0100 Subject: [PATCH 19/40] Add other func declaration possibility --- src/Defines.hs | 2 ++ test/Spec.hs | 8 ++++++++ 2 files changed, 10 insertions(+) diff --git a/src/Defines.hs b/src/Defines.hs index e88771d..b359c3a 100644 --- a/src/Defines.hs +++ b/src/Defines.hs @@ -49,5 +49,7 @@ registerFunction env fnName fnParams fnBodies handleDefine :: Env -> Tree -> (Env, Result) handleDefine env (List [Symbol _, Symbol smbl, List (Symbol "lambda": List fnParams : fnBodies)]) = (registerFunction env smbl (List fnParams) fnBodies, Left (Nothing)) +handleDefine env (List [Symbol _, (List (Symbol smbl : fnParams)), List fnBodies]) + = (registerFunction env smbl (List fnParams) (List fnBodies : []), Left (Nothing)) handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl expr, Left (Nothing)) handleDefine env _ = (registerError env "Bad define", Right (undefined)) diff --git a/test/Spec.hs b/test/Spec.hs index 447a9f0..6ddf5dc 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -241,6 +241,14 @@ unitTestsComputeFunctions = testGroup "Tests compute functions" assertEqual "(define func (lambda (x) (+ 1 x))); (func 41)" (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["x"], bodies = [List [Symbol "+", Number 1, Symbol "x"]]}]}, [Left (Just (Number 42))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "x"], List [Symbol "+", Number 1, Symbol "x"]]]), (List [Symbol "func", Number 41])]) + , testCase "(define (add a b) (+ a b)); (add 1 2)" $ + assertEqual "(define (add a b) (+ a b)); (add 1 2)" + (Env {defines = [], errors = [], functions = [Function {name = "add", params = ["a", "b"], bodies = [List [Symbol "+", Symbol "a", Symbol "b"]]}]}, [Left (Just (Number 3))]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", List [Symbol "add", Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]]), (List [Symbol "add", Number 1, Number 2])]) + , testCase "(define (func x) (+ x 1)); (func 41)" $ + assertEqual "(define (func x) (+ x 1)); (func 41)" + (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["x"], bodies = [List [Symbol "+", Symbol "x", Number 1]]}]}, [Left (Just (Number 42))]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", List [Symbol "func", Symbol "x"], List [Symbol "+", Symbol "x", Number 1]]), (List [Symbol "func", Number 41])]) ] unitTestsComputeConditions :: TestTree From 17f4f023a87869ce2e4a84c2d6d100c117d4bae3 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 00:41:02 +0100 Subject: [PATCH 20/40] add more tests --- test/Spec.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index 6ddf5dc..9d0dd4d 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -257,4 +257,20 @@ unitTestsComputeConditions = testGroup "Tests compute conditions" assertEqual "(if #t 42 84)" (Env {defines = [], errors = [], functions = []}, Left (Just (Number 42))) (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "if", Boolean True, Number 42, Number 84])) - ] + , testCase "(if #f (3 + 3) (4 + 4))" $ + assertEqual "(if #f (3 + 3) (4 + 4))" + (Env {defines = [], errors = [], functions = []}, Left (Just (Number 8))) + (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "if", Boolean False, (List [Symbol "+", Number 3, Number 3]), (List [Symbol "+", Number 4, Number 4])])) + , testCase "define foo 42; (if (< foo 10) (* foo 3) (div foo 2))" $ + assertEqual "define foo 42; (if (< foo 10) (* foo 3) (div foo 2))" + (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 21))]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "<", Symbol "foo", Number 10]), (List [Symbol "*", Symbol "foo", Number 3]), (List [Symbol "div", Symbol "foo", Number 2])])]) + , testCase "define foo 42; (if (eq? foo 42) (+ foo 42) (- foo 42))" $ + assertEqual "define foo 42; (if (eq? foo 42) (+ foo 42) (- foo 42))" + (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 84))]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "eq?", Symbol "foo", Number 42]), (List [Symbol "+", Symbol "foo", Number 42]), (List [Symbol "-", Symbol "foo", Number 42])])]) + , testCase "define foo 42; (if (eq? foo 22) (+ foo 42) (- foo 42))" $ + assertEqual "define foo 42; (if (eq? foo 22) (+ foo 42) (- foo 42))" + (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 0))]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "eq?", Symbol "foo", Number 22]), (List [Symbol "+", Symbol "foo", Number 42]), (List [Symbol "-", Symbol "foo", Number 42])])]) + ] \ No newline at end of file From 8a0bb8cbee24964b604c7db4e37f9147915d303f Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 00:41:17 +0100 Subject: [PATCH 21/40] Add eof --- test/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Spec.hs b/test/Spec.hs index 9d0dd4d..73f733b 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -273,4 +273,4 @@ unitTestsComputeConditions = testGroup "Tests compute conditions" assertEqual "define foo 42; (if (eq? foo 22) (+ foo 42) (- foo 42))" (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 0))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "eq?", Symbol "foo", Number 22]), (List [Symbol "+", Symbol "foo", Number 42]), (List [Symbol "-", Symbol "foo", Number 42])])]) - ] \ No newline at end of file + ] From ba17645cf2ed16c463bcaa6a547ffcf1e7d6d697 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 00:54:39 +0100 Subject: [PATCH 22/40] Add support of if --- src/ComputeAST.hs | 98 ++++++++++++++++++++++++++++------------------- 1 file changed, 59 insertions(+), 39 deletions(-) diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index 22b64ae..93674a7 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -131,12 +131,56 @@ modulo env list | length list /= 2 = (registerError env "% need 2 params", Right (undefined)) | otherwise = (registerError env "Bad types in modulo", Right (undefined)) +------------------------- CONDITIONS --------------------------------- +equal :: Env -> [Tree] -> (Env, Result) +equal env [Number a, Number b] = (env, Left (Just (Boolean (a == b)))) +equal env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env b = + (env, Left (Just (Boolean (a == symbolValue)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +equal env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env a = + (env, Left (Just (Boolean (symbolValue == b)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +equal env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = + (env, Left (Just (Boolean (symbolValueA == symbolValueB)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +equal env list + | length list /= 2 = (registerError env "eq? need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in eq?", Right (undefined)) ----------------------------------------------------------------------------------- +inferior :: Env -> [Tree] -> (Env, Result) +inferior env [Number a, Number b] = (env, Left (Just (Boolean (a < b)))) +inferior env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env b = + (env, Left (Just (Boolean (a < symbolValue)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +inferior env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env a = + (env, Left (Just (Boolean (symbolValue < b)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +inferior env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = + (env, Left (Just (Boolean (symbolValueA < symbolValueB)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +inferior env list + | length list /= 2 = (registerError env "< need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in <", Right (undefined)) +handleIf :: Env -> [Tree] -> (Env, Result) +handleIf env (Boolean (True) : thenBranch : _ : []) + = computeASTWithoutList env thenBranch +handleIf env (Boolean (False) : _ : elseBranch : []) + = computeASTWithoutList env elseBranch +handleIf env _ = (registerError env "Bad if statement", Right (undefined)) +---------------------------------------------------------------------------------- +-- Evaluate a symbol and return its value evaluateSymbol :: Env -> Symbol -> (Env, Maybe Tree) evaluateSymbol env smbl = case getSymbolValue env smbl of @@ -149,12 +193,9 @@ evaluateSymbol env smbl = (_, _) -> (env, Nothing) (_, _) -> (env, Nothing) - - ---------------------------------------------------------------------------------- - -- Find nested lists and resolve them resolveNestedLists :: Env -> [Tree] -> [Tree] -> (Env, Maybe [Tree]) resolveNestedLists env resolvedList [] = (env, Just resolvedList) @@ -175,18 +216,8 @@ resolveNestedLists env resolvedList (Boolean value : rest) = resolveNestedLists env resolvedList (Symbol smbl : rest) = resolveNestedLists env (resolvedList ++ [Symbol smbl]) rest - - - - - - ---------------------------------------------------------------------------------- - - - - -- Compute simple lists (no nested lists) handleSimpleList :: Env -> [Tree] -> (Env, Result) handleSimpleList env (Symbol "+" : rest) = addition env rest @@ -194,6 +225,9 @@ handleSimpleList env (Symbol "*" : rest) = multiplication env rest handleSimpleList env (Symbol "-" : rest) = subtraction env rest handleSimpleList env (Symbol "div" : rest) = division env rest handleSimpleList env (Symbol "mod" : rest) = modulo env rest +handleSimpleList env (Symbol "eq?" : rest) = equal env rest +handleSimpleList env (Symbol "<" : rest) = inferior env rest +handleSimpleList env (Symbol "if" : rest) = handleIf env rest handleSimpleList env (Symbol smbl : rest) = case getFunctionByName env smbl of Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Right (undefined)) @@ -203,29 +237,14 @@ handleSimpleList env (Symbol smbl : rest) = (newEnv, _) -> (env { errors = errors newEnv }, Right (undefined)) handleSimpleList env _ = (registerError env "Bad function call", Right (undefined)) --- Compute nested lists -handleDeepList :: Env -> [Tree] -> (Env, Result) -handleDeepList env list - | not (doesListContainsList list) = handleSimpleList env list - | otherwise = - case resolveNestedLists env [] list of - (newEnv, Nothing) -> (newEnv, Right (undefined)) - (newEnv, Just resolvedList) -> handleDeepList newEnv resolvedList - - ---------------------------------------------------------------------------------- - handleLambda :: Env -> Tree -> (Env, Result) handleLambda env (List (List (Symbol "lambda" : List fnParams : fnBodies): (List args): _)) = computeFunction env (Function "" (getParams (List fnParams)) fnBodies) args handleLambda env _ = (registerError env "Bad lambda", Left (Nothing)) - - -------------------------------------------------------------------------------------- - - +--------------------------- COMPUTE FUNCTIONS -------------------------------- computeFunctionBody :: Env -> Function -> [Tree] -> (Env, Result) computeFunctionBody env (Function _ _ []) _ = (env, Left (Nothing)) @@ -246,12 +265,8 @@ computeFunction env (Function fnName fnParams (x:_)) args = computeFunction env _ _ = (registerError env "Bad function call", Right (undefined)) +--------------------------- COMPUTE AST ------------------------------------- -------------------------------------------------------------------------------------- - - - --- Compute AST that doesn't contain a list computeASTWithoutList :: Env -> Tree -> (Env, Result) computeASTWithoutList env (Number nbr) = (env, Left (Just (Number nbr))) computeASTWithoutList env (Boolean value) = (env, Left (Just (Boolean value))) @@ -262,11 +277,16 @@ computeASTWithoutList env (Symbol smbl) where (_, value) = getSymbolValue env smbl computeASTWithoutList env _ = (env, Right (undefined)) --- Compute entire AST +computeAstWithList :: Env -> Tree -> (Env, Result) +computeAstWithList env (List list) + | not (doesListContainsList list) = handleSimpleList env list + | otherwise = case resolveNestedLists env [] list of + (newEnv, Nothing) -> (newEnv, Right (undefined)) + (newEnv, Just rvd) -> computeAST newEnv (List rvd) +computeAstWithList env _ = (registerError env "Bad list", Right (undefined)) + computeAST :: Env -> Tree -> (Env, Result) computeAST env tree@(List (Symbol "define" : _)) = handleDefine env tree computeAST env tree@(List (List (Symbol "lambda" : _) : _)) = handleLambda env tree -computeAST env (List list) - | doesListContainsList list = handleDeepList env list - | otherwise = handleSimpleList env list +computeAST env tree@(List _) = computeAstWithList env tree computeAST env tree = computeASTWithoutList env tree From 6d13756ede0dbfe56368612705be382e697875cd Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 02:51:06 +0100 Subject: [PATCH 23/40] add more conditions --- src/ComputeAST.hs | 80 +++++++++++++++++++++++++++++++++++++++++++++++ test/Spec.hs | 8 +++++ 2 files changed, 88 insertions(+) diff --git a/src/ComputeAST.hs b/src/ComputeAST.hs index 93674a7..436cee9 100644 --- a/src/ComputeAST.hs +++ b/src/ComputeAST.hs @@ -152,6 +152,25 @@ equal env list | length list /= 2 = (registerError env "eq? need 2 params", Right (undefined)) | otherwise = (registerError env "Bad types in eq?", Right (undefined)) +notEqual :: Env -> [Tree] -> (Env, Result) +notEqual env [Number a, Number b] = (env, Left (Just (Boolean (a /= b)))) +notEqual env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env b = + (env, Left (Just (Boolean (a /= symbolValue)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +notEqual env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env a = + (env, Left (Just (Boolean (symbolValue /= b)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +notEqual env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = + (env, Left (Just (Boolean (symbolValueA /= symbolValueB)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +notEqual env list + | length list /= 2 = (registerError env "not-eq? need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in not-eq?", Right (undefined)) + inferior :: Env -> [Tree] -> (Env, Result) inferior env [Number a, Number b] = (env, Left (Just (Boolean (a < b)))) inferior env [Number a, Symbol b] @@ -171,6 +190,63 @@ inferior env list | length list /= 2 = (registerError env "< need 2 params", Right (undefined)) | otherwise = (registerError env "Bad types in <", Right (undefined)) +superior :: Env -> [Tree] -> (Env, Result) +superior env [Number a, Number b] = (env, Left (Just (Boolean (a > b)))) +superior env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env b = + (env, Left (Just (Boolean (a > symbolValue)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +superior env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env a = + (env, Left (Just (Boolean (symbolValue > b)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +superior env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = + (env, Left (Just (Boolean (symbolValueA > symbolValueB)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +superior env list + | length list /= 2 = (registerError env "> need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in >", Right (undefined)) + +inferiorOrEqual :: Env -> [Tree] -> (Env, Result) +inferiorOrEqual env [Number a, Number b] = (env, Left (Just (Boolean (a <= b)))) +inferiorOrEqual env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env b = + (env, Left (Just (Boolean (a <= symbolValue)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +inferiorOrEqual env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env a = + (env, Left (Just (Boolean (symbolValue <= b)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +inferiorOrEqual env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = + (env, Left (Just (Boolean (symbolValueA <= symbolValueB)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +inferiorOrEqual env list + | length list /= 2 = (registerError env "<= need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in <=", Right (undefined)) + +superiorOrEqual :: Env -> [Tree] -> (Env, Result) +superiorOrEqual env [Number a, Number b] = (env, Left (Just (Boolean (a >= b)))) +superiorOrEqual env [Number a, Symbol b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env b = + (env, Left (Just (Boolean (a >= symbolValue)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +superiorOrEqual env [Symbol a, Number b] + | (_, Just (Number symbolValue)) <- evaluateSymbol env a = + (env, Left (Just (Boolean (symbolValue >= b)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +superiorOrEqual env [Symbol a, Symbol b] + | (_, Just (Number symbolValueA)) <- evaluateSymbol env a + , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = + (env, Left (Just (Boolean (symbolValueA >= symbolValueB)))) + | otherwise = (registerError env "Symbol not found", Right (undefined)) +superiorOrEqual env list + | length list /= 2 = (registerError env ">= need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in >=", Right (undefined)) + handleIf :: Env -> [Tree] -> (Env, Result) handleIf env (Boolean (True) : thenBranch : _ : []) = computeASTWithoutList env thenBranch @@ -226,7 +302,11 @@ handleSimpleList env (Symbol "-" : rest) = subtraction env rest handleSimpleList env (Symbol "div" : rest) = division env rest handleSimpleList env (Symbol "mod" : rest) = modulo env rest handleSimpleList env (Symbol "eq?" : rest) = equal env rest +handleSimpleList env (Symbol "diff?" : rest) = notEqual env rest handleSimpleList env (Symbol "<" : rest) = inferior env rest +handleSimpleList env (Symbol ">" : rest) = superior env rest +handleSimpleList env (Symbol "<=" : rest) = inferiorOrEqual env rest +handleSimpleList env (Symbol ">=" : rest) = superiorOrEqual env rest handleSimpleList env (Symbol "if" : rest) = handleIf env rest handleSimpleList env (Symbol smbl : rest) = case getFunctionByName env smbl of diff --git a/test/Spec.hs b/test/Spec.hs index 73f733b..8f61adb 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -273,4 +273,12 @@ unitTestsComputeConditions = testGroup "Tests compute conditions" assertEqual "define foo 42; (if (eq? foo 22) (+ foo 42) (- foo 42))" (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 0))]) (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "eq?", Symbol "foo", Number 22]), (List [Symbol "+", Symbol "foo", Number 42]), (List [Symbol "-", Symbol "foo", Number 42])])]) + , testCase "define foo 42; (if (diff? foo 22) (false) (true))" $ + assertEqual "define foo 42; (if (diff? foo 22) (false) (true))" + (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Boolean True))]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "diff?", Symbol "foo", Number 22]), Boolean True, Boolean False])]) + , testCase "define foo 42; (if (diff? foo 42) (true) (false))" $ + assertEqual "define foo 42; (if (diff? foo 42) (true) (false))" + (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Boolean False))]) + (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "diff?", Symbol "foo", Number 42]), Boolean True, Boolean False])]) ] From 55fc259e5729ad7373c52788804071e97e5d9b37 Mon Sep 17 00:00:00 2001 From: Tenshi <87119012+TTENSHII@users.noreply.github.com> Date: Sun, 17 Dec 2023 11:03:06 +0100 Subject: [PATCH 24/40] Update src/Types.hs --- src/Types.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Types.hs b/src/Types.hs index b0e2fb5..80b74a4 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -16,7 +16,6 @@ module Types ) where import Data.Int (Int64) -import Data.Either (Either) import Data.Void (Void) type Symbol = String From e80648e087409305fc5ccf7d265da2f8e341a49d Mon Sep 17 00:00:00 2001 From: guillaume abel Date: Sun, 17 Dec 2023 13:11:48 +0100 Subject: [PATCH 25/40] Add test --- test/Spec.hs | 118 +++++++++++++++++++++++++++++---------------------- 1 file changed, 67 insertions(+), 51 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index 8f61adb..fad6b75 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -107,24 +107,27 @@ computeAllAST env (x:xs) = do let (newEnv2, results) = computeAllAST newEnv xs (newEnv2, results) +defaultEnv :: Env +defaultEnv = Env {defines = [], errors = [], functions = []} + unitTestComputeTypes :: TestTree unitTestComputeTypes = testGroup "Tests Compute Types" [ testCase "bool true" $ assertEqual "bool true" - (Env {defines = [], errors = [], functions = []}, Left (Just (Boolean True))) - (computeAST (Env {defines = [], errors = [], functions = []}) (Boolean True)) + (defaultEnv, Left (Just (Boolean True))) + (computeAST (defaultEnv) (Boolean True)) , testCase "bool false" $ assertEqual "bool false" - (Env {defines = [], errors = [], functions = []}, Left (Just (Boolean False))) - (computeAST (Env {defines = [], errors = [], functions = []}) (Boolean False)) + (defaultEnv, Left (Just (Boolean False))) + (computeAST (defaultEnv) (Boolean False)) , testCase "number 42" $ assertEqual "number 42" - (Env {defines = [], errors = [], functions = []}, Left (Just (Number 42))) - (computeAST (Env {defines = [], errors = [], functions = []}) (Number 42)) + (defaultEnv, Left (Just (Number 42))) + (computeAST (defaultEnv) (Number 42)) , testCase "number -42" $ assertEqual "number -42" - (Env {defines = [], errors = [], functions = []}, Left (Just (Number (-42)))) - (computeAST (Env {defines = [], errors = [], functions = []}) (Number (-42))) + (defaultEnv, Left (Just (Number (-42)))) + (computeAST (defaultEnv) (Number (-42))) ] unitTestsComputeDefines :: TestTree @@ -132,55 +135,55 @@ unitTestsComputeDefines = testGroup "Tests Compute defines" [ testCase "define x 42" $ assertEqual "define x 42" (Env {defines = [Define {symbol = "x", expression = Number 42}], errors = [], functions = []}, Left (Nothing)) - (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "define", Symbol "x", Number 42])) + (computeAST (defaultEnv) (List [Symbol "define", Symbol "x", Number 42])) , testCase "define x 42; x" $ assertEqual "define x 42; x" (Env {defines = [Define {symbol = "x", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 42))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", Number 42]), (Symbol "x")]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "x", Number 42]), (Symbol "x")]) , testCase "define x 42; define y 84" $ assertEqual "define x 42; define y 84" (Env {defines = [Define {symbol = "x", expression = Number 42}, Define {symbol = "y", expression = Number 84}], errors = [], functions = []}, []) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84])]) , testCase "define x 42; define y 84; x; y" $ assertEqual "define x 42; define y 84; x; y" (Env {defines = [Define {symbol = "x", expression = Number 42}, Define {symbol = "y", expression = Number 84}], errors = [], functions = []}, [Left (Just (Number 42)), Left (Just (Number 84))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84]), (Symbol "x"), (Symbol "y")]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84]), (Symbol "x"), (Symbol "y")]) , testCase "define x (42 + 6); x" $ assertEqual "define x (42 + 6); x" (Env {defines = [Define {symbol = "x", expression = List [Symbol "+", Number 42, Number 6]}], errors = [], functions = []}, [Left (Just (Number 48))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "x", (List [Symbol "+", Number 42, Number 6])]), (Symbol "x")]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "x", (List [Symbol "+", Number 42, Number 6])]), (Symbol "x")]) , testCase "define foo (4 + 5); foo + foo" $ assertEqual "define foo (4 + 5); foo + foo" (Env {defines = [Define {symbol = "foo", expression = List [Symbol "+", Number 4, Number 5]}], errors = [], functions = []}, [Left (Just (Number 18))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", (List [Symbol "+", Number 4, Number 5])]), (List [Symbol "+", Symbol "foo", Symbol "foo"])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", (List [Symbol "+", Number 4, Number 5])]), (List [Symbol "+", Symbol "foo", Symbol "foo"])]) ] unitTestsComputeSimpleFunctions :: TestTree unitTestsComputeSimpleFunctions = testGroup "Tests compute + - div mod" [ testCase "42 + 42" $ assertEqual "42 + 42" - (Env {defines = [], errors = [], functions = []}, Left (Just (Number 84))) - (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "+", Number 42, Number 42])) + (defaultEnv, Left (Just (Number 84))) + (computeAST (defaultEnv) (List [Symbol "+", Number 42, Number 42])) , testCase "-42 + -42" $ assertEqual "-42 + -42" - (Env {defines = [], errors = [], functions = []}, Left (Just (Number (-84)))) - (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "+", Number (-42), Number (-42)])) + (defaultEnv, Left (Just (Number (-84)))) + (computeAST (defaultEnv) (List [Symbol "+", Number (-42), Number (-42)])) , testCase "42 + dontexist" $ assertEqual "42 + dontexist" (Env {defines = [], errors = ["Symbol not found"], functions = []}, Right (undefined)) - (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "+", Number 42, Symbol "dontexist"])) + (computeAST (defaultEnv) (List [Symbol "+", Number 42, Symbol "dontexist"])) , testCase "bool + number" $ assertEqual "bool + number" (Env {defines = [], errors = ["Bad types in addition"], functions = []}, Right (undefined)) - (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "+", Boolean True, Number 42])) + (computeAST (defaultEnv) (List [Symbol "+", Boolean True, Number 42])) , testCase "20 / 2 + 3 * 5 - 10" $ assertEqual "20 / 2 + 3 * 5 - 10" - (Env {defines = [], errors = [], functions = []}, Left (Just (Number 15))) - (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "-", (List [Symbol "+", (List [Symbol "div", Number 20, Number 2]), (List [Symbol "*", Number 3, Number 5])]), Number 10])) + (defaultEnv, Left (Just (Number 15))) + (computeAST (defaultEnv) (List [Symbol "-", (List [Symbol "+", (List [Symbol "div", Number 20, Number 2]), (List [Symbol "*", Number 3, Number 5])]), Number 10])) , testCase "11 mod 3" $ assertEqual "11 mod 3" - (Env {defines = [], errors = [], functions = []}, Left (Just (Number 2))) - (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "mod", Number 11, Number 3])) + (defaultEnv, Left (Just (Number 2))) + (computeAST (defaultEnv) (List [Symbol "mod", Number 11, Number 3])) ] unitTestsComputeBasics :: TestTree @@ -188,23 +191,23 @@ unitTestsComputeBasics = testGroup "Tests compute basics" [ testCase "define foo 42; foo + foo" $ assertEqual "define foo 42; foo + foo" (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 84))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "+", Symbol "foo", Symbol "foo"])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "+", Symbol "foo", Symbol "foo"])]) , testCase "define foo 42; define bar 42; foo + bar" $ assertEqual "define foo 42; define bar 42; foo + bar" (Env {defines = [Define {symbol = "foo", expression = Number 42}, Define {symbol = "bar", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 84))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "define", Symbol "bar", Number 42]), (List [Symbol "+", Symbol "foo", Symbol "bar"])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "define", Symbol "bar", Number 42]), (List [Symbol "+", Symbol "foo", Symbol "bar"])]) , testCase "2 + 2 * 5" $ assertEqual "2 + 2 * 5" - (Env {defines = [], errors = [], functions = []}, [Left (Just (Number 12))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 2, Number 5])])]) + (defaultEnv, [Left (Just (Number 12))]) + (computeAllAST (defaultEnv) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 2, Number 5])])]) , testCase "2 + 2 * (foo + 10) = 106" $ assertEqual "2 + 2 * (foo + 10) = 106" (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 106))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "+", Number 2, (List [Symbol "*", Number 2, (List [Symbol "+", Symbol "foo", Number 10])])])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "+", Number 2, (List [Symbol "*", Number 2, (List [Symbol "+", Symbol "foo", Number 10])])])]) , testCase "2 + 3 * (8 + (5* ( 2 + 3))) = 107" $ assertEqual "2 + 3 * (8 + (5* ( 2 + 3))) = 107" - (Env {defines = [], errors = [], functions = []}, [Left (Just (Number 101))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 3, (List [Symbol "+", Number 8, (List [Symbol "*", Number 5, (List [Symbol "+", Number 2, Number 3])])])])])]) + (defaultEnv, [Left (Just (Number 101))]) + (computeAllAST (defaultEnv) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 3, (List [Symbol "+", Number 8, (List [Symbol "*", Number 5, (List [Symbol "+", Number 2, Number 3])])])])])]) ] unitTestsComputeFunctions :: TestTree @@ -212,73 +215,86 @@ unitTestsComputeFunctions = testGroup "Tests compute functions" [ testCase "(define add (lambda (a b) (+ a b))); (add 1 2)" $ assertEqual "(define add (lambda (a b) (+ a b))); (add 1 2)" (Env {defines = [], errors = [], functions = [Function {name = "add", params = ["a", "b"], bodies = [(List [Symbol "+", Symbol "a", Symbol "b"])]}]}, [Left (Just (Number 3))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "add", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "+", Symbol "a", Symbol "b"]]]), (List [Symbol "add", Number 1, Number 2])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "add", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "+", Symbol "a", Symbol "b"]]]), (List [Symbol "add", Number 1, Number 2])]) , testCase "(define sub (lambda (a b) (- a b))); (sub 84 42)" $ assertEqual "(define sub (lambda (a b) (- a b))); (sub 84 42)" (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b"], bodies = [(List [Symbol "-", Symbol "a", Symbol "b"])]}]}, [Left (Just (Number 42))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "-", Symbol "a", Symbol "b"]]]), (List [Symbol "sub", Number 84, Number 42])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "-", Symbol "a", Symbol "b"]]]), (List [Symbol "sub", Number 84, Number 42])]) , testCase "(define sub (lambda (a b c d e) (+ a (+ b (* 8 (+ d e))); (sub 84 42 1 2 3)" $ assertEqual "(define sub (lambda (a b c d e) (+ a (+ b (* 8 (+ d e))); (sub 84 42 1 2 3)" (Env {defines = [], errors = [], functions = [Function {name = "sub", params = ["a", "b", "c", "d", "e"], bodies = [(List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])])]}]}, [Left (Just (Number 166))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b", Symbol "c", Symbol "d", Symbol "e" ], List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])]]]), (List [Symbol "sub", Number 84, Number 42, Number 1, Number 2, Number 3])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "sub", List [Symbol "lambda", List [Symbol "a", Symbol "b", Symbol "c", Symbol "d", Symbol "e" ], List [Symbol "+", Symbol "a", (List [Symbol "+", Symbol "b", (List [Symbol "*", Number 8, (List [Symbol "+", Symbol "d", Symbol "e"])])])]]]), (List [Symbol "sub", Number 84, Number 42, Number 1, Number 2, Number 3])]) , testCase "(define func (lambda (a b) (define foo a) (+ foo b))); (func 1 2)" $ assertEqual "(define func (lambda (a b) (define foo a) (+ foo b))); (func 1 2)" (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["a", "b"], bodies = [(List [Symbol "define", Symbol "foo", Symbol "a", (List [Symbol "+", Symbol "foo", Symbol "b"])])]}]}, [Left (Just (Number 3))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "a", Symbol "b" ], List [Symbol "define", Symbol "foo", Symbol "a"], List [Symbol "+", Symbol "foo", Symbol "b"]]]), (List [Symbol "func", Number 1, Number 2])]) , testCase "((lambda (a b) (+ a b)) 1 2)" $ assertEqual "((lambda (a b) (+ a b)) 1 2)" - (Env {defines = [], errors = [], functions = []}, Left (Just (Number 3))) - (computeAST (Env {defines = [], errors = [], functions = []}) (List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number 2]])) + (defaultEnv, Left (Just (Number 3))) + (computeAST (defaultEnv) (List [List [Symbol "lambda", List [Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]], List [Number 1, Number 2]])) , testCase "(define func (lambda () (define foo 42) (foo))); (func)" $ assertEqual "(define func (lambda () (define foo 42) (foo))); (func)" (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "define", Symbol "foo", Number 42], Symbol "foo"]}]}, [Left (Just (Number 42))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "define", Symbol "foo", Number 42], Symbol "foo"]]), (List [Symbol "func"])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "define", Symbol "foo", Number 42], Symbol "foo"]]), (List [Symbol "func"])]) , testCase "(define func (lambda () (+ 42 42))); (func)" $ assertEqual "(define func (lambda () (+ 42 42))); (func)" (Env {defines = [], errors = [], functions = [Function {name = "func", params = [], bodies = [List [Symbol "+", Number 42, Number 42]]}]}, [Left (Just (Number 84))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "+", Number 42, Number 42]]]), (List [Symbol "func"])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [], List [Symbol "+", Number 42, Number 42]]]), (List [Symbol "func"])]) , testCase "(define func (lambda (x) (+ 1 x))); (func 41)" $ assertEqual "(define func (lambda (x) (+ 1 x))); (func 41)" (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["x"], bodies = [List [Symbol "+", Number 1, Symbol "x"]]}]}, [Left (Just (Number 42))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "x"], List [Symbol "+", Number 1, Symbol "x"]]]), (List [Symbol "func", Number 41])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "func", List [Symbol "lambda", List [Symbol "x"], List [Symbol "+", Number 1, Symbol "x"]]]), (List [Symbol "func", Number 41])]) , testCase "(define (add a b) (+ a b)); (add 1 2)" $ assertEqual "(define (add a b) (+ a b)); (add 1 2)" (Env {defines = [], errors = [], functions = [Function {name = "add", params = ["a", "b"], bodies = [List [Symbol "+", Symbol "a", Symbol "b"]]}]}, [Left (Just (Number 3))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", List [Symbol "add", Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]]), (List [Symbol "add", Number 1, Number 2])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", List [Symbol "add", Symbol "a", Symbol "b"], List [Symbol "+", Symbol "a", Symbol "b"]]), (List [Symbol "add", Number 1, Number 2])]) , testCase "(define (func x) (+ x 1)); (func 41)" $ assertEqual "(define (func x) (+ x 1)); (func 41)" (Env {defines = [], errors = [], functions = [Function {name = "func", params = ["x"], bodies = [List [Symbol "+", Symbol "x", Number 1]]}]}, [Left (Just (Number 42))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", List [Symbol "func", Symbol "x"], List [Symbol "+", Symbol "x", Number 1]]), (List [Symbol "func", Number 41])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", List [Symbol "func", Symbol "x"], List [Symbol "+", Symbol "x", Number 1]]), (List [Symbol "func", Number 41])]) ] unitTestsComputeConditions :: TestTree unitTestsComputeConditions = testGroup "Tests compute conditions" [ testCase "(if #t 42 84)" $ assertEqual "(if #t 42 84)" - (Env {defines = [], errors = [], functions = []}, Left (Just (Number 42))) - (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "if", Boolean True, Number 42, Number 84])) + (defaultEnv, Left (Just (Number 42))) + (computeAST (defaultEnv) (List [Symbol "if", Boolean True, Number 42, Number 84])) , testCase "(if #f (3 + 3) (4 + 4))" $ assertEqual "(if #f (3 + 3) (4 + 4))" - (Env {defines = [], errors = [], functions = []}, Left (Just (Number 8))) - (computeAST (Env {defines = [], errors = [], functions = []}) (List [Symbol "if", Boolean False, (List [Symbol "+", Number 3, Number 3]), (List [Symbol "+", Number 4, Number 4])])) + (defaultEnv, Left (Just (Number 8))) + (computeAST (defaultEnv) (List [Symbol "if", Boolean False, (List [Symbol "+", Number 3, Number 3]), (List [Symbol "+", Number 4, Number 4])])) , testCase "define foo 42; (if (< foo 10) (* foo 3) (div foo 2))" $ assertEqual "define foo 42; (if (< foo 10) (* foo 3) (div foo 2))" (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 21))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "<", Symbol "foo", Number 10]), (List [Symbol "*", Symbol "foo", Number 3]), (List [Symbol "div", Symbol "foo", Number 2])])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "<", Symbol "foo", Number 10]), (List [Symbol "*", Symbol "foo", Number 3]), (List [Symbol "div", Symbol "foo", Number 2])])]) , testCase "define foo 42; (if (eq? foo 42) (+ foo 42) (- foo 42))" $ assertEqual "define foo 42; (if (eq? foo 42) (+ foo 42) (- foo 42))" (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 84))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "eq?", Symbol "foo", Number 42]), (List [Symbol "+", Symbol "foo", Number 42]), (List [Symbol "-", Symbol "foo", Number 42])])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "eq?", Symbol "foo", Number 42]), (List [Symbol "+", Symbol "foo", Number 42]), (List [Symbol "-", Symbol "foo", Number 42])])]) , testCase "define foo 42; (if (eq? foo 22) (+ foo 42) (- foo 42))" $ assertEqual "define foo 42; (if (eq? foo 22) (+ foo 42) (- foo 42))" (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 0))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "eq?", Symbol "foo", Number 22]), (List [Symbol "+", Symbol "foo", Number 42]), (List [Symbol "-", Symbol "foo", Number 42])])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "eq?", Symbol "foo", Number 22]), (List [Symbol "+", Symbol "foo", Number 42]), (List [Symbol "-", Symbol "foo", Number 42])])]) , testCase "define foo 42; (if (diff? foo 22) (false) (true))" $ assertEqual "define foo 42; (if (diff? foo 22) (false) (true))" (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Boolean True))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "diff?", Symbol "foo", Number 22]), Boolean True, Boolean False])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "diff?", Symbol "foo", Number 22]), Boolean True, Boolean False])]) , testCase "define foo 42; (if (diff? foo 42) (true) (false))" $ assertEqual "define foo 42; (if (diff? foo 42) (true) (false))" (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = [], functions = []}, [Left (Just (Boolean False))]) - (computeAllAST (Env {defines = [], errors = [], functions = []}) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "diff?", Symbol "foo", Number 42]), Boolean True, Boolean False])]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "if", (List [Symbol "diff?", Symbol "foo", Number 42]), Boolean True, Boolean False])]) + , testCase "(define foo 9); (define (func x) (if (< x 10) #t #f)); (func foo)" $ + assertEqual "(define foo 9); (define (func x) (if (< x 10) #t #f)); (func foo)" + (Env {defines = [Define {symbol = "foo", expression = Number 9}], errors = [], functions = [ + Function {name = "func", params = ["x"], bodies = [ + (List [Symbol "if", (List [Symbol "<", Symbol "x", Number 10]), Boolean True, Boolean False]) + ]} + ]}, [Left (Just (Boolean True))]) + (computeAllAST + (defaultEnv) + [ + (List [Symbol "define", Symbol "foo", Number 9]), + (List [Symbol "define", (List [Symbol "func", Symbol "x"]), (List [Symbol "if", (List [Symbol "<", Symbol "x", Number 10]), Boolean True, Boolean False])]), + (List [Symbol "func", Symbol "foo"])]) ] From 77a35e4620faf4fbf62a59cd9dd1e6e04b2f9b7e Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 13:43:23 +0100 Subject: [PATCH 26/40] adapt checkParsing to new Result type --- app/Run.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/app/Run.hs b/app/Run.hs index 5190d83..ef0a581 100644 --- a/app/Run.hs +++ b/app/Run.hs @@ -24,14 +24,16 @@ printErrors hand (Env defines_ [] funcs_) = printErrors hand (Env defines_ errors_ funcs_) = mapM_ putStrLn errors_ >> handleInput hand (Env defines_ [] funcs_) -checkComputing :: HHHandle -> (Env, Maybe Result) -> IO () -checkComputing hand (env, Nothing) = printErrors hand env -checkComputing hand (env, Just result) = print result >> handleInput hand env +checkComputing :: HHHandle -> (Env, Result) -> IO () +checkComputing hand (env, Right _) = printErrors hand env +checkComputing hand (env, Left Nothing) = handleInput hand env +checkComputing hand (env, Left (Just result)) = + print result >> handleInput hand env checkParsing :: HHHandle -> Maybe (Tree, String) -> Env -> IO () checkParsing _ Nothing _ = return () ---checkParsing hand (Just (tree, _)) env = --- checkComputing hand (computeAST env tree) +checkParsing hand (Just (tree, _)) env = + checkComputing hand (computeAST env tree) checkInput :: HHHandle -> String -> Env -> IO () checkInput _ ":q" _ = return () From 3203f83303ed02f27581645b697ba8283347de8e Mon Sep 17 00:00:00 2001 From: guillaume abel Date: Sun, 17 Dec 2023 15:07:07 +0100 Subject: [PATCH 27/40] Split code, failing test --- koaky.cabal | 3 + src/Computing/ComputeAST.hs | 245 +--------------------- src/Computing/Defines.hs | 6 +- src/Computing/Operators/Assert.hs | 55 +++++ src/Computing/Operators/Calculate.hs | 55 +++++ src/Computing/Operators/EvaluateSymbol.hs | 18 ++ 6 files changed, 136 insertions(+), 246 deletions(-) create mode 100644 src/Computing/Operators/Assert.hs create mode 100644 src/Computing/Operators/Calculate.hs create mode 100644 src/Computing/Operators/EvaluateSymbol.hs diff --git a/koaky.cabal b/koaky.cabal index 68d8bba..96c129a 100644 --- a/koaky.cabal +++ b/koaky.cabal @@ -32,6 +32,9 @@ library Computing.Functions Computing.ListContainList Computing.ReplaceFunctionParams + Computing.Operators.Assert + Computing.Operators.Calculate + Computing.Operators.EvaluateSymbol KoakyLibVersion Parsing.Parser Types diff --git a/src/Computing/ComputeAST.hs b/src/Computing/ComputeAST.hs index a42e9fb..19ea2fe 100644 --- a/src/Computing/ComputeAST.hs +++ b/src/Computing/ComputeAST.hs @@ -8,7 +8,6 @@ module Computing.ComputeAST ( computeAST, - evaluateSymbol ) where import Types @@ -17,236 +16,11 @@ import Computing.ReplaceFunctionParams import Computing.Defines import Computing.Functions import Computing.Errors - --- Compute a "+ - div * mod" list, using defines if needed - -addition :: Env -> [Tree] -> (Env, Result) -addition env [Number a, Number b] = (env, Left (Just (Number (a + b)))) -addition env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Left (Just (Number (a + symbolValue)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -addition env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Left (Just (Number (symbolValue + b)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -addition env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Left (Just (Number (symbolValueA + symbolValueB)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -addition env list - | length list /= 2 = (registerError env "Addition need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in addition", Right (undefined)) - -multiplication :: Env -> [Tree] -> (Env, Result) -multiplication env [Number a, Number b] = (env, Left (Just (Number (a * b)))) -multiplication env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Left(Just (Number (a * symbolValue)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -multiplication env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Left (Just (Number (symbolValue * b)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -multiplication env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Left (Just (Number (symbolValueA * symbolValueB)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -multiplication env list - | length list /= 2 = (registerError env "* need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in multiplication", Right (undefined)) - -subtraction :: Env -> [Tree] -> (Env, Result) -subtraction env [Number a, Number b] = (env, Left (Just (Number (a - b)))) -subtraction env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Left (Just (Number (a - symbolValue)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -subtraction env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Left (Just (Number (symbolValue - b)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -subtraction env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Left (Just (Number (symbolValueA - symbolValueB)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -subtraction env list - | length list /= 2 = (registerError env "- need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in subtraction", Right (undefined)) - -division :: Env -> [Tree] -> (Env, Result) -division env [Number a, Number b] - | b == 0 = (registerError env "Division by 0", Right (undefined)) - | otherwise = (env, Left (Just (Number (a `div` b)))) -division env [Symbol a, Number b] - | b == 0 = (registerError env "Division by 0", Right (undefined)) - | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Left (Just (Number (symbolValue `div` b)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -division env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env b - , symbolValue == 0 = (registerError env "Division by 0", Right (undefined)) - | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Left (Just (Number (a `div` symbolValue)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -division env [Symbol a, Symbol b] - | (_, Just (Number _)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b - , symbolValueB == 0 = (registerError env "Division by 0", Right (undefined)) - | (_, Just (Number symbolValueA)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Left (Just (Number (symbolValueA `div` symbolValueB)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -division env list - | length list /= 2 = (registerError env "/ need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in division", Right (undefined)) - -modulo :: Env -> [Tree] -> (Env, Result) -modulo env [Number a, Number b] - | b == 0 = (registerError env "Modulo by 0", Right (undefined)) - | otherwise = (env, Left (Just (Number (a `mod` b)))) -modulo env [Symbol a, Number b] - | b == 0 = (registerError env "Modulo by 0", Right (undefined)) - | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Left (Just (Number (symbolValue `mod` b)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -modulo env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env b - , symbolValue == 0 = (registerError env "Modulo by 0", Right (undefined)) - | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Left (Just (Number (a `mod` symbolValue)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -modulo env [Symbol a, Symbol b] - | (_, Just (Number _)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b - , symbolValueB == 0 = (registerError env "Modulo by 0", Right (undefined)) - | (_, Just (Number symbolValueA)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Left (Just (Number (symbolValueA `mod` symbolValueB)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -modulo env list - | length list /= 2 = (registerError env "% need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in modulo", Right (undefined)) +import Computing.Operators.Calculate +import Computing.Operators.Assert ------------------------- CONDITIONS --------------------------------- -equal :: Env -> [Tree] -> (Env, Result) -equal env [Number a, Number b] = (env, Left (Just (Boolean (a == b)))) -equal env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Left (Just (Boolean (a == symbolValue)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -equal env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Left (Just (Boolean (symbolValue == b)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -equal env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Left (Just (Boolean (symbolValueA == symbolValueB)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -equal env list - | length list /= 2 = (registerError env "eq? need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in eq?", Right (undefined)) - -notEqual :: Env -> [Tree] -> (Env, Result) -notEqual env [Number a, Number b] = (env, Left (Just (Boolean (a /= b)))) -notEqual env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Left (Just (Boolean (a /= symbolValue)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -notEqual env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Left (Just (Boolean (symbolValue /= b)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -notEqual env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Left (Just (Boolean (symbolValueA /= symbolValueB)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -notEqual env list - | length list /= 2 = (registerError env "not-eq? need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in not-eq?", Right (undefined)) - -inferior :: Env -> [Tree] -> (Env, Result) -inferior env [Number a, Number b] = (env, Left (Just (Boolean (a < b)))) -inferior env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Left (Just (Boolean (a < symbolValue)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -inferior env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Left (Just (Boolean (symbolValue < b)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -inferior env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Left (Just (Boolean (symbolValueA < symbolValueB)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -inferior env list - | length list /= 2 = (registerError env "< need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in <", Right (undefined)) - -superior :: Env -> [Tree] -> (Env, Result) -superior env [Number a, Number b] = (env, Left (Just (Boolean (a > b)))) -superior env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Left (Just (Boolean (a > symbolValue)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -superior env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Left (Just (Boolean (symbolValue > b)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -superior env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Left (Just (Boolean (symbolValueA > symbolValueB)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -superior env list - | length list /= 2 = (registerError env "> need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in >", Right (undefined)) - -inferiorOrEqual :: Env -> [Tree] -> (Env, Result) -inferiorOrEqual env [Number a, Number b] = (env, Left (Just (Boolean (a <= b)))) -inferiorOrEqual env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Left (Just (Boolean (a <= symbolValue)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -inferiorOrEqual env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Left (Just (Boolean (symbolValue <= b)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -inferiorOrEqual env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Left (Just (Boolean (symbolValueA <= symbolValueB)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -inferiorOrEqual env list - | length list /= 2 = (registerError env "<= need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in <=", Right (undefined)) - -superiorOrEqual :: Env -> [Tree] -> (Env, Result) -superiorOrEqual env [Number a, Number b] = (env, Left (Just (Boolean (a >= b)))) -superiorOrEqual env [Number a, Symbol b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env b = - (env, Left (Just (Boolean (a >= symbolValue)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -superiorOrEqual env [Symbol a, Number b] - | (_, Just (Number symbolValue)) <- evaluateSymbol env a = - (env, Left (Just (Boolean (symbolValue >= b)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -superiorOrEqual env [Symbol a, Symbol b] - | (_, Just (Number symbolValueA)) <- evaluateSymbol env a - , (_, Just (Number symbolValueB)) <- evaluateSymbol env b = - (env, Left (Just (Boolean (symbolValueA >= symbolValueB)))) - | otherwise = (registerError env "Symbol not found", Right (undefined)) -superiorOrEqual env list - | length list /= 2 = (registerError env ">= need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in >=", Right (undefined)) - handleIf :: Env -> [Tree] -> (Env, Result) handleIf env (Boolean (True) : thenBranch : _ : []) = computeASTWithoutList env thenBranch @@ -256,21 +30,6 @@ handleIf env _ = (registerError env "Bad if statement", Right (undefined)) ---------------------------------------------------------------------------------- --- Evaluate a symbol and return its value -evaluateSymbol :: Env -> Symbol -> (Env, Maybe Tree) -evaluateSymbol env smbl = - case getSymbolValue env smbl of - (_, Nothing) -> (env, Nothing) - (_, Just (Number number)) -> (env, Just (Number number)) - (_, Just (Boolean value)) -> (env, Just (Boolean value)) - (_, Just (List list)) -> - case computeAST env (List list) of - (_, Left (Just result)) -> (env, Just result) - (_, _) -> (env, Nothing) - (_, _) -> (env, Nothing) - ----------------------------------------------------------------------------------- - -- Find nested lists and resolve them resolveNestedLists :: Env -> [Tree] -> [Tree] -> (Env, Maybe [Tree]) diff --git a/src/Computing/Defines.hs b/src/Computing/Defines.hs index 9f9a861..00973ce 100644 --- a/src/Computing/Defines.hs +++ b/src/Computing/Defines.hs @@ -20,9 +20,9 @@ import Computing.Errors getSymbolValue :: Env -> String -> (Env, Maybe Tree) getSymbolValue (Env { defines = [], errors = _, functions = _ }) _ = (Env { defines = [], errors = [], functions = [] }, Nothing) -getSymbolValue (Env { defines = (Define smbl value):xs, errors = err }) expr - | smbl == expr = (Env { defines = xs, errors = err, functions = [] }, Just value) - | otherwise = getSymbolValue (Env { defines = xs, errors = err, functions = [] }) expr +getSymbolValue (Env { defines = (Define smbl value):xs, errors = err, functions = fcts }) expr + | smbl == expr = (Env { defines = xs, errors = err, functions = fcts }, Just value) + | otherwise = getSymbolValue (Env { defines = xs, errors = err, functions = fcts }) expr -- Register a define in the Defines list registerDefine :: Env -> Symbol -> Tree -> Env diff --git a/src/Computing/Operators/Assert.hs b/src/Computing/Operators/Assert.hs new file mode 100644 index 0000000..77a5fd3 --- /dev/null +++ b/src/Computing/Operators/Assert.hs @@ -0,0 +1,55 @@ +module Computing.Operators.Assert + ( + equal, + notEqual, + inferior, + inferiorOrEqual, + superior, + superiorOrEqual + ) where + +import Types +import Computing.Operators.EvaluateSymbol +import Data.Int (Int64) +import Computing.Errors + +assert :: Int64 -> Int64 -> Symbol -> Tree +assert a b ">" = Boolean (a > b) +assert a b "<" = Boolean (a < b) +assert a b ">=" = Boolean (a >= b) +assert a b "<=" = Boolean (a <= b) +assert a b "eq?" = Boolean (a == b) +assert a b "diff?" = Boolean (a /= b) +assert _ _ _ = Boolean (False) + +maybeAssert :: Maybe Tree -> Maybe Tree -> Symbol -> Env -> (Env, Result) +maybeAssert (Just (Number a)) (Just (Number b)) operator env = (env, Left (Just (assert a b operator))) +maybeAssert _ _ _ env = (registerError env "Symbol not found", Right (undefined)) + +assertOperator :: Env -> [Tree] -> Symbol -> (Env, Result) +assertOperator env [Number a, Number b] operator = (env, Left (Just (assert a b operator))) +assertOperator env [Number a, Symbol b] operator = maybeAssert (Just (Number a)) (evaluateSymbol env b) operator env +assertOperator env [Symbol a, Number b] operator = maybeAssert (evaluateSymbol env a) (Just (Number b)) operator env +assertOperator env [Symbol a, Symbol b] operator = maybeAssert (evaluateSymbol env a) (evaluateSymbol env b) operator env +assertOperator env list _ + | length list /= 2 = (registerError env "assert need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in assert", Right (undefined)) + +equal :: Env -> [Tree] -> (Env, Result) +equal env trees = assertOperator env trees "eq?" + +notEqual :: Env -> [Tree] -> (Env, Result) +notEqual env trees = assertOperator env trees "diff?" + +inferior :: Env -> [Tree] -> (Env, Result) +inferior env trees = assertOperator env trees "<" + +superior :: Env -> [Tree] -> (Env, Result) +superior env trees = assertOperator env trees ">" + +inferiorOrEqual :: Env -> [Tree] -> (Env, Result) +inferiorOrEqual env trees = assertOperator env trees "<=" + +superiorOrEqual :: Env -> [Tree] -> (Env, Result) +superiorOrEqual env trees = assertOperator env trees ">=" + diff --git a/src/Computing/Operators/Calculate.hs b/src/Computing/Operators/Calculate.hs new file mode 100644 index 0000000..2e689d1 --- /dev/null +++ b/src/Computing/Operators/Calculate.hs @@ -0,0 +1,55 @@ +module Computing.Operators.Calculate + ( + addition, + subtraction, + multiplication, + division, + modulo, + ) where + +import Computing.Operators.EvaluateSymbol +import Types +import Data.Int (Int64) +import Computing.Errors + +-- Compute a "+ - div * mod" list, using defines if needed + +calculate :: Int64 -> Int64 -> Symbol -> Tree +calculate a b "+" = Number (a + b) +calculate a b "-" = Number (a - b) +calculate a b "*" = Number (a * b) +calculate a b "div" = Number (a `div` b) +calculate a b "mod" = Number (a `mod` b) +calculate _ _ _ = Number 0 + +maybeCalculate :: Maybe Tree -> Maybe Tree -> Symbol -> Env -> (Env, Result) +maybeCalculate (Just (Number a)) (Just (Number b)) operator env = (env, Left (Just (calculate a b operator))) +maybeCalculate _ _ _ env = (registerError env "Symbol not found", Right (undefined)) + +calculateOperator :: Env -> [Tree] -> Symbol -> (Env, Result) +calculateOperator env [Number a, Number b] operator = + (env, Left (Just (calculate a b operator))) +calculateOperator env [Number a, Symbol b] operator = + maybeCalculate (Just (Number a)) (evaluateSymbol env b) operator env +calculateOperator env [Symbol a, Number b] operator = + maybeCalculate (evaluateSymbol env a) (Just (Number b)) operator env +calculateOperator env [Symbol a, Symbol b] operator = + maybeCalculate (evaluateSymbol env a) (evaluateSymbol env b) operator env +calculateOperator env list _ + | length list /= 2 = (registerError env "Addition need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in addition", Right (undefined)) + +addition :: Env -> [Tree] -> (Env, Result) +addition env trees = calculateOperator env trees "+" + +subtraction :: Env -> [Tree] -> (Env, Result) +subtraction env trees = calculateOperator env trees "-" + +multiplication :: Env -> [Tree] -> (Env, Result) +multiplication env trees = calculateOperator env trees "*" + +division :: Env -> [Tree] -> (Env, Result) +division env trees = calculateOperator env trees "div" + +modulo :: Env -> [Tree] -> (Env, Result) +modulo env trees = calculateOperator env trees "mod" diff --git a/src/Computing/Operators/EvaluateSymbol.hs b/src/Computing/Operators/EvaluateSymbol.hs new file mode 100644 index 0000000..1f8eab0 --- /dev/null +++ b/src/Computing/Operators/EvaluateSymbol.hs @@ -0,0 +1,18 @@ + +module Computing.Operators.EvaluateSymbol + ( + evaluateSymbol + ) where + +import Types +import Computing.Defines + +-- Evaluate a symbol and return its value +evaluateSymbol :: Env -> Symbol -> Maybe Tree +evaluateSymbol env smbl = + case getSymbolValue env smbl of + (_, Nothing) -> Nothing + (_, Just (Number number)) -> Just (Number number) + (_, Just (Boolean value)) -> Just (Boolean value) + (_, Just (List list)) -> Just (List list) + (_, _) -> Nothing From 9a64ce12418e539190f5183519c97260fbf41181 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 18:15:31 +0100 Subject: [PATCH 28/40] fix some norm error --- koaky.cabal | 2 +- src/Computing/ComputeAST.hs | 1 - src/Computing/Defines.hs | 26 +++++++++----- src/Computing/Functions.hs | 9 +++-- src/Computing/Operators/Assert.hs | 47 ++++++++++++++++---------- src/Computing/Operators/Calculate.hs | 35 ++++++++++++------- src/Computing/ReplaceFunctionParams.hs | 3 +- src/Types.hs | 3 +- 8 files changed, 81 insertions(+), 45 deletions(-) diff --git a/koaky.cabal b/koaky.cabal index 96c129a..06f416a 100644 --- a/koaky.cabal +++ b/koaky.cabal @@ -31,10 +31,10 @@ library Computing.Errors Computing.Functions Computing.ListContainList - Computing.ReplaceFunctionParams Computing.Operators.Assert Computing.Operators.Calculate Computing.Operators.EvaluateSymbol + Computing.ReplaceFunctionParams KoakyLibVersion Parsing.Parser Types diff --git a/src/Computing/ComputeAST.hs b/src/Computing/ComputeAST.hs index 19ea2fe..2a4ae44 100644 --- a/src/Computing/ComputeAST.hs +++ b/src/Computing/ComputeAST.hs @@ -30,7 +30,6 @@ handleIf env _ = (registerError env "Bad if statement", Right (undefined)) ---------------------------------------------------------------------------------- - -- Find nested lists and resolve them resolveNestedLists :: Env -> [Tree] -> [Tree] -> (Env, Maybe [Tree]) resolveNestedLists env resolvedList [] = (env, Just resolvedList) diff --git a/src/Computing/Defines.hs b/src/Computing/Defines.hs index 00973ce..b78471b 100644 --- a/src/Computing/Defines.hs +++ b/src/Computing/Defines.hs @@ -20,9 +20,12 @@ import Computing.Errors getSymbolValue :: Env -> String -> (Env, Maybe Tree) getSymbolValue (Env { defines = [], errors = _, functions = _ }) _ = (Env { defines = [], errors = [], functions = [] }, Nothing) -getSymbolValue (Env { defines = (Define smbl value):xs, errors = err, functions = fcts }) expr - | smbl == expr = (Env { defines = xs, errors = err, functions = fcts }, Just value) - | otherwise = getSymbolValue (Env { defines = xs, errors = err, functions = fcts }) expr +getSymbolValue (Env { defines = (Define smbl value):xs, + errors = err, functions = fcts }) expr + | smbl == expr = + (Env { defines = xs, errors = err, functions = fcts }, Just value) + | otherwise = getSymbolValue + (Env { defines = xs, errors = err, functions = fcts }) expr -- Register a define in the Defines list registerDefine :: Env -> Symbol -> Tree -> Env @@ -32,7 +35,8 @@ registerDefine env symb value = -- Add a function to the Functions list in the Env addFunction :: Env -> String -> [String] -> [Tree] -> Env addFunction env fnName fnParams fnBodies - = Env (defines env) (errors env) (functions env ++ [Function fnName fnParams fnBodies]) + = Env (defines env) (errors env) + (functions env ++ [Function fnName fnParams fnBodies]) -- Get params from a function getParams :: Tree -> [String] @@ -47,9 +51,13 @@ registerFunction env fnName fnParams fnBodies = addFunction env fnName (getParams fnParams) fnBodies handleDefine :: Env -> Tree -> (Env, Result) -handleDefine env (List [Symbol _, Symbol smbl, List (Symbol "lambda": List fnParams : fnBodies)]) - = (registerFunction env smbl (List fnParams) fnBodies, Left (Nothing)) -handleDefine env (List [Symbol _, (List (Symbol smbl : fnParams)), List fnBodies]) - = (registerFunction env smbl (List fnParams) (List fnBodies : []), Left (Nothing)) -handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl expr, Left (Nothing)) +handleDefine env (List [Symbol _, Symbol smbl, + List (Symbol "lambda": List fnParams : fnBodies)]) = + (registerFunction env smbl (List fnParams) fnBodies, Left (Nothing)) +handleDefine env (List [Symbol _, + (List (Symbol smbl : fnParams)), List fnBodies]) = + (registerFunction env smbl (List fnParams) (List fnBodies : []), + Left (Nothing)) +handleDefine env (List [Symbol _, Symbol smbl, expr]) = + (registerDefine env smbl expr, Left (Nothing)) handleDefine env _ = (registerError env "Bad define", Right (undefined)) diff --git a/src/Computing/Functions.hs b/src/Computing/Functions.hs index 1b0af15..a31c75e 100644 --- a/src/Computing/Functions.hs +++ b/src/Computing/Functions.hs @@ -14,6 +14,9 @@ import Types -- Find and execute user defined function getFunctionByName :: Env -> String -> Maybe Function getFunctionByName (Env { functions = [] }) _ = Nothing -getFunctionByName (Env { functions = (Function fnName fnParams body):xs, defines = defs, errors = errs }) expr - | fnName == expr = Just (Function fnName fnParams body) - | otherwise = getFunctionByName (Env { functions = xs, defines = defs, errors = errs }) expr +getFunctionByName (Env { functions = (Function fnName fnParams body):xs, + defines = defs, errors = errs }) expr + | fnName == expr = Just (Function fnName fnParams body) + | otherwise = + getFunctionByName (Env { functions = xs, defines = defs, + errors = errs }) expr diff --git a/src/Computing/Operators/Assert.hs b/src/Computing/Operators/Assert.hs index 77a5fd3..b1e583d 100644 --- a/src/Computing/Operators/Assert.hs +++ b/src/Computing/Operators/Assert.hs @@ -1,12 +1,19 @@ +{- +-- EPITECH PROJECT, 2023 +-- Koaky +-- File description: +-- Assert +-} + module Computing.Operators.Assert - ( - equal, - notEqual, - inferior, - inferiorOrEqual, - superior, - superiorOrEqual - ) where + ( + equal, + notEqual, + inferior, + inferiorOrEqual, + superior, + superiorOrEqual + ) where import Types import Computing.Operators.EvaluateSymbol @@ -23,17 +30,24 @@ assert a b "diff?" = Boolean (a /= b) assert _ _ _ = Boolean (False) maybeAssert :: Maybe Tree -> Maybe Tree -> Symbol -> Env -> (Env, Result) -maybeAssert (Just (Number a)) (Just (Number b)) operator env = (env, Left (Just (assert a b operator))) -maybeAssert _ _ _ env = (registerError env "Symbol not found", Right (undefined)) +maybeAssert (Just (Number a)) (Just (Number b)) operator env = + (env, Left (Just (assert a b operator))) +maybeAssert _ _ _ env = + (registerError env "Symbol not found", Right (undefined)) assertOperator :: Env -> [Tree] -> Symbol -> (Env, Result) -assertOperator env [Number a, Number b] operator = (env, Left (Just (assert a b operator))) -assertOperator env [Number a, Symbol b] operator = maybeAssert (Just (Number a)) (evaluateSymbol env b) operator env -assertOperator env [Symbol a, Number b] operator = maybeAssert (evaluateSymbol env a) (Just (Number b)) operator env -assertOperator env [Symbol a, Symbol b] operator = maybeAssert (evaluateSymbol env a) (evaluateSymbol env b) operator env +assertOperator env [Number a, Number b] operator = + (env, Left (Just (assert a b operator))) +assertOperator env [Number a, Symbol b] operator = + maybeAssert (Just (Number a)) (evaluateSymbol env b) operator env +assertOperator env [Symbol a, Number b] operator = + maybeAssert (evaluateSymbol env a) (Just (Number b)) operator env +assertOperator env [Symbol a, Symbol b] operator = + maybeAssert (evaluateSymbol env a) (evaluateSymbol env b) operator env assertOperator env list _ - | length list /= 2 = (registerError env "assert need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in assert", Right (undefined)) + | length list /= 2 = + (registerError env "assert need 2 params", Right (undefined)) + | otherwise = (registerError env "Bad types in assert", Right (undefined)) equal :: Env -> [Tree] -> (Env, Result) equal env trees = assertOperator env trees "eq?" @@ -52,4 +66,3 @@ inferiorOrEqual env trees = assertOperator env trees "<=" superiorOrEqual :: Env -> [Tree] -> (Env, Result) superiorOrEqual env trees = assertOperator env trees ">=" - diff --git a/src/Computing/Operators/Calculate.hs b/src/Computing/Operators/Calculate.hs index 2e689d1..d344e94 100644 --- a/src/Computing/Operators/Calculate.hs +++ b/src/Computing/Operators/Calculate.hs @@ -1,16 +1,23 @@ +{- +-- EPITECH PROJECT, 2023 +-- Koaky +-- File description: +-- Calculate +-} + module Computing.Operators.Calculate - ( - addition, - subtraction, - multiplication, - division, - modulo, - ) where + ( + addition, + subtraction, + multiplication, + division, + modulo, + ) where -import Computing.Operators.EvaluateSymbol import Types import Data.Int (Int64) import Computing.Errors +import Computing.Operators.EvaluateSymbol -- Compute a "+ - div * mod" list, using defines if needed @@ -23,8 +30,10 @@ calculate a b "mod" = Number (a `mod` b) calculate _ _ _ = Number 0 maybeCalculate :: Maybe Tree -> Maybe Tree -> Symbol -> Env -> (Env, Result) -maybeCalculate (Just (Number a)) (Just (Number b)) operator env = (env, Left (Just (calculate a b operator))) -maybeCalculate _ _ _ env = (registerError env "Symbol not found", Right (undefined)) +maybeCalculate (Just (Number a)) (Just (Number b)) operator env = + (env, Left (Just (calculate a b operator))) +maybeCalculate _ _ _ env = + (registerError env "Symbol not found", Right (undefined)) calculateOperator :: Env -> [Tree] -> Symbol -> (Env, Result) calculateOperator env [Number a, Number b] operator = @@ -36,8 +45,10 @@ calculateOperator env [Symbol a, Number b] operator = calculateOperator env [Symbol a, Symbol b] operator = maybeCalculate (evaluateSymbol env a) (evaluateSymbol env b) operator env calculateOperator env list _ - | length list /= 2 = (registerError env "Addition need 2 params", Right (undefined)) - | otherwise = (registerError env "Bad types in addition", Right (undefined)) + | length list /= 2 = + (registerError env "Addition need 2 params", Right (undefined)) + | otherwise = + (registerError env "Bad types in addition", Right (undefined)) addition :: Env -> [Tree] -> (Env, Result) addition env trees = calculateOperator env trees "+" diff --git a/src/Computing/ReplaceFunctionParams.hs b/src/Computing/ReplaceFunctionParams.hs index 88cea2a..924e506 100644 --- a/src/Computing/ReplaceFunctionParams.hs +++ b/src/Computing/ReplaceFunctionParams.hs @@ -17,7 +17,8 @@ replaceSymbol t _ _ = t replaceFunctionParams :: Env -> [String] -> Tree -> [Tree] -> (Env, Maybe Tree) replaceFunctionParams env fnParams body args - | length fnParams /= length args = (registerError env "Mismatched number of arguments", Nothing) + | length fnParams /= length args = + (registerError env "Mismatched number of arguments", Nothing) | otherwise = let replacement = zip fnParams args replacedbody = foldl (\acc (param, arg) -> replaceSymbol acc param arg) body replacement diff --git a/src/Types.hs b/src/Types.hs index 80b74a4..9e6f4c3 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -69,4 +69,5 @@ instance Show Tree where instance Show Env where show (Env { defines = def, errors = err, functions = func }) = - "Defines: " ++ show def ++ "\nErrors: " ++ show err ++ "\nFunctions: " ++ show func + "Defines: " ++ show def ++ "\nErrors: " + ++ show err ++ "\nFunctions: " ++ show func From 71d04cc4e787791ea2cde6d4d034a67d4918e2ca Mon Sep 17 00:00:00 2001 From: guillaume abel Date: Sun, 17 Dec 2023 18:15:37 +0100 Subject: [PATCH 29/40] Add multiple line handler --- app/Run.hs | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/app/Run.hs b/app/Run.hs index 55caba0..c942ac2 100644 --- a/app/Run.hs +++ b/app/Run.hs @@ -22,29 +22,29 @@ printErrors :: HHHandle -> Env -> IO () printErrors hand (Env defines_ []) = printErrors hand (Env defines_ ["Unable to compute"]) printErrors hand (Env defines_ errors_) = - mapM_ putStrLn errors_ >> handleInput hand (Env defines_ []) + mapM_ putStrLn errors_ >> handleInput hand (Env defines_ []) [] checkComputing :: HHHandle -> (Env, Maybe Result) -> IO () checkComputing hand (env, Nothing) = printErrors hand env -checkComputing hand (env, Just result) = print result >> handleInput hand env +checkComputing hand (env, Just result) = print result >> handleInput hand env [] -checkParsing :: HHHandle -> Maybe (Tree, String) -> Env -> IO () -checkParsing _ Nothing _ = return () -checkParsing hand (Just (tree, _)) env = +checkParsing :: HHHandle -> String -> Maybe (Tree, String) -> Env -> IO () +checkParsing hand str Nothing env = handleInput hand env str +checkParsing hand _ (Just (tree, _)) env = checkComputing hand (computeAST env tree) checkInput :: HHHandle -> String -> Env -> IO () checkInput _ ":q" _ = return () -checkInput hand input env = checkParsing hand (runParser (parseTree) input) env +checkInput hand input env = checkParsing hand input (runParser (parseTree) input) env -checkEOF :: HHHandle -> Env -> Bool -> IO () -checkEOF _ _ True = return () -checkEOF (HHHandle ff shouldClosee) env False = hGetLine ff >>= - (\x -> checkInput (HHHandle ff shouldClosee) x env) +checkEOF :: HHHandle -> Env -> String -> Bool -> IO () +checkEOF _ _ _ True = return () +checkEOF (HHHandle ff shouldClosee) env prevStr False = hGetLine ff >>= + (\x -> checkInput (HHHandle ff shouldClosee) (prevStr ++ x) env) -handleInput :: HHHandle -> Env -> IO () -handleInput (HHHandle ff shouldClosee) env = - hIsEOF ff >>= (\x -> checkEOF (HHHandle ff shouldClosee) env x) +handleInput :: HHHandle -> Env -> String -> IO () +handleInput (HHHandle ff shouldClosee) env prevStr = + hIsEOF ff >>= (\x -> checkEOF (HHHandle ff shouldClosee) env prevStr x) runStdin :: IO () runStdin = runFileHandle stdin False @@ -58,5 +58,5 @@ onEnd _ = return () runFileHandle :: Handle -> Bool -> IO () runFileHandle ff shouldClosee = - handleInput (HHHandle ff shouldClosee) (Env [] []) >> + handleInput (HHHandle ff shouldClosee) (Env [] []) [] >> onEnd (HHHandle ff shouldClosee) From 5ed924b066c458c14fa06a57a4d98aada334391e Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 18:17:17 +0100 Subject: [PATCH 30/40] add Epitech Header --- src/Computing/Operators/EvaluateSymbol.hs | 12 +++++++++--- src/Computing/ReplaceFunctionParams.hs | 6 ++++++ 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/src/Computing/Operators/EvaluateSymbol.hs b/src/Computing/Operators/EvaluateSymbol.hs index 1f8eab0..aedac51 100644 --- a/src/Computing/Operators/EvaluateSymbol.hs +++ b/src/Computing/Operators/EvaluateSymbol.hs @@ -1,8 +1,14 @@ +{- +-- EPITECH PROJECT, 2023 +-- Koaky +-- File description: +-- EvaluateSymbol +-} module Computing.Operators.EvaluateSymbol - ( - evaluateSymbol - ) where + ( + evaluateSymbol + ) where import Types import Computing.Defines diff --git a/src/Computing/ReplaceFunctionParams.hs b/src/Computing/ReplaceFunctionParams.hs index 924e506..b247cd1 100644 --- a/src/Computing/ReplaceFunctionParams.hs +++ b/src/Computing/ReplaceFunctionParams.hs @@ -1,3 +1,9 @@ +{- +-- EPITECH PROJECT, 2023 +-- Koaky +-- File description: +-- ReplaceFunctionParams +-} module Computing.ReplaceFunctionParams ( From 4daa61a68b4a28b81d58752c072a50fee781a4e6 Mon Sep 17 00:00:00 2001 From: guillaume abel Date: Sun, 17 Dec 2023 18:18:33 +0100 Subject: [PATCH 31/40] Fix norm --- app/Run.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/app/Run.hs b/app/Run.hs index c942ac2..aeaefbf 100644 --- a/app/Run.hs +++ b/app/Run.hs @@ -26,7 +26,8 @@ printErrors hand (Env defines_ errors_) = checkComputing :: HHHandle -> (Env, Maybe Result) -> IO () checkComputing hand (env, Nothing) = printErrors hand env -checkComputing hand (env, Just result) = print result >> handleInput hand env [] +checkComputing hand (env, Just result) = + print result >> handleInput hand env [] checkParsing :: HHHandle -> String -> Maybe (Tree, String) -> Env -> IO () checkParsing hand str Nothing env = handleInput hand env str @@ -35,7 +36,8 @@ checkParsing hand _ (Just (tree, _)) env = checkInput :: HHHandle -> String -> Env -> IO () checkInput _ ":q" _ = return () -checkInput hand input env = checkParsing hand input (runParser (parseTree) input) env +checkInput hand input env = + checkParsing hand input (runParser (parseTree) input) env checkEOF :: HHHandle -> Env -> String -> Bool -> IO () checkEOF _ _ _ True = return () From 0d30b9857b39914dee4cc30a5f56bb61272d70df Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 18:27:49 +0100 Subject: [PATCH 32/40] fix too long line --- src/Computing/ComputeAST.hs | 6 ++++-- src/Computing/Defines.hs | 3 ++- src/Computing/ReplaceFunctionParams.hs | 5 ++--- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/Computing/ComputeAST.hs b/src/Computing/ComputeAST.hs index 2a4ae44..0d34c84 100644 --- a/src/Computing/ComputeAST.hs +++ b/src/Computing/ComputeAST.hs @@ -100,7 +100,8 @@ computeFunction env (Function fnName fnParams (x:_)) args = case computeFunctionBody env (Function fnName fnParams [x]) args of (newEnv, Left (Just replaced)) -> computeAST newEnv replaced (newEnv, _) -> (registerError newEnv "Missing return in function", Right (undefined)) -computeFunction env _ _ = (registerError env "Bad function call", Right (undefined)) +computeFunction env _ _ = + (registerError env "Bad function call", Right (undefined)) --------------------------- COMPUTE AST ------------------------------------- @@ -125,6 +126,7 @@ computeAstWithList env _ = (registerError env "Bad list", Right (undefined)) computeAST :: Env -> Tree -> (Env, Result) computeAST env tree@(List (Symbol "define" : _)) = handleDefine env tree -computeAST env tree@(List (List (Symbol "lambda" : _) : _)) = handleLambda env tree +computeAST env tree@(List (List (Symbol "lambda" : _) : _)) = + handleLambda env tree computeAST env tree@(List _) = computeAstWithList env tree computeAST env tree = computeASTWithoutList env tree diff --git a/src/Computing/Defines.hs b/src/Computing/Defines.hs index b78471b..f48f116 100644 --- a/src/Computing/Defines.hs +++ b/src/Computing/Defines.hs @@ -46,7 +46,8 @@ getParams _ = [] -- Register a function in the Functions list registerFunction :: Env -> Symbol -> Tree -> [Tree] -> Env -registerFunction env "" _ _ = registerError env "function name must not be empty" +registerFunction env "" _ _ = + registerError env "function name must not be empty" registerFunction env fnName fnParams fnBodies = addFunction env fnName (getParams fnParams) fnBodies diff --git a/src/Computing/ReplaceFunctionParams.hs b/src/Computing/ReplaceFunctionParams.hs index b247cd1..34f26ed 100644 --- a/src/Computing/ReplaceFunctionParams.hs +++ b/src/Computing/ReplaceFunctionParams.hs @@ -26,6 +26,5 @@ replaceFunctionParams env fnParams body args | length fnParams /= length args = (registerError env "Mismatched number of arguments", Nothing) | otherwise = - let replacement = zip fnParams args - replacedbody = foldl (\acc (param, arg) -> replaceSymbol acc param arg) body replacement - in (env, Just replacedbody) + (env, Just $ foldl (\acc (param, arg) -> replaceSymbol acc param arg) + body (zip fnParams args)) From 99c2a7adab75510b9b4a43b30d716ab9016e13f0 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 18:31:40 +0100 Subject: [PATCH 33/40] fix norm in computeAst --- src/Computing/ComputeAST.hs | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/src/Computing/ComputeAST.hs b/src/Computing/ComputeAST.hs index 0d34c84..9f7459b 100644 --- a/src/Computing/ComputeAST.hs +++ b/src/Computing/ComputeAST.hs @@ -68,18 +68,22 @@ handleSimpleList env (Symbol ">=" : rest) = superiorOrEqual env rest handleSimpleList env (Symbol "if" : rest) = handleIf env rest handleSimpleList env (Symbol smbl : rest) = case getFunctionByName env smbl of - Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), Right (undefined)) + Nothing -> (registerError env ("Function " ++ smbl ++ " not found"), + Right (undefined)) Just func -> case computeFunction env func rest of (_, Left (Just result)) -> (env, Left (Just result)) - (newEnv, _) -> (env { errors = errors newEnv }, Right (undefined)) -handleSimpleList env _ = (registerError env "Bad function call", Right (undefined)) + (newEnv, _) -> (env {errors = errors newEnv}, Right(undefined)) +handleSimpleList env _ = + (registerError env "Bad function call", Right (undefined)) ----------------------------------------------------------------------------------- +----------------------------------------------------------------------------- handleLambda :: Env -> Tree -> (Env, Result) -handleLambda env (List (List (Symbol "lambda" : List fnParams : fnBodies): (List args): _)) - = computeFunction env (Function "" (getParams (List fnParams)) fnBodies) args +handleLambda env (List (List (Symbol "lambda" : List fnParams : fnBodies): + (List args): _)) = + computeFunction env + (Function "" (getParams (List fnParams)) fnBodies) args handleLambda env _ = (registerError env "Bad lambda", Left (Nothing)) --------------------------- COMPUTE FUNCTIONS -------------------------------- @@ -94,16 +98,18 @@ computeFunctionBody env (Function _ fnParams (x:_)) args = computeFunction :: Env -> Function -> [Tree] -> (Env, Result) computeFunction env (Function fnName fnParams (x:xs:rest)) args = case computeFunctionBody env (Function fnName fnParams [x]) args of - (newEnv, Left (Nothing)) -> computeFunction newEnv (Function fnName fnParams (xs:rest)) args - (_, _) -> (registerError env "Return needs to be the last statement", Right (undefined)) + (newEnv, Left (Nothing)) -> + computeFunction newEnv (Function fnName fnParams (xs:rest)) args + (_, _) -> + (registerError env "Bad return placement", Right (undefined)) computeFunction env (Function fnName fnParams (x:_)) args = case computeFunctionBody env (Function fnName fnParams [x]) args of (newEnv, Left (Just replaced)) -> computeAST newEnv replaced - (newEnv, _) -> (registerError newEnv "Missing return in function", Right (undefined)) + (newEnv, _) -> + (registerError newEnv "Missing return in func", Right (undefined)) computeFunction env _ _ = (registerError env "Bad function call", Right (undefined)) - --------------------------- COMPUTE AST ------------------------------------- computeASTWithoutList :: Env -> Tree -> (Env, Result) From 442eb034978520222d22ce30fd5f57c097efd084 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 20:21:30 +0100 Subject: [PATCH 34/40] fix division by zero --- src/Computing/ComputeAST.hs | 1 - src/Computing/Operators/Calculate.hs | 22 +++++++++++++--------- test/Spec.hs | 4 ++++ 3 files changed, 17 insertions(+), 10 deletions(-) diff --git a/src/Computing/ComputeAST.hs b/src/Computing/ComputeAST.hs index 9f7459b..9b93c8a 100644 --- a/src/Computing/ComputeAST.hs +++ b/src/Computing/ComputeAST.hs @@ -94,7 +94,6 @@ computeFunctionBody env (Function _ fnParams (x:_)) args = case replaceFunctionParams env fnParams x args of (newEnv, Nothing) -> (newEnv, Right (undefined)) (newEnv, Just replaced) -> computeAST newEnv replaced - computeFunction :: Env -> Function -> [Tree] -> (Env, Result) computeFunction env (Function fnName fnParams (x:xs:rest)) args = case computeFunctionBody env (Function fnName fnParams [x]) args of diff --git a/src/Computing/Operators/Calculate.hs b/src/Computing/Operators/Calculate.hs index d344e94..c6db955 100644 --- a/src/Computing/Operators/Calculate.hs +++ b/src/Computing/Operators/Calculate.hs @@ -7,11 +7,11 @@ module Computing.Operators.Calculate ( - addition, - subtraction, - multiplication, - division, - modulo, + addition, + subtraction, + multiplication, + division, + modulo, ) where import Types @@ -30,20 +30,24 @@ calculate a b "mod" = Number (a `mod` b) calculate _ _ _ = Number 0 maybeCalculate :: Maybe Tree -> Maybe Tree -> Symbol -> Env -> (Env, Result) +maybeCalculate _ (Just (Number 0)) "div" env + = (registerError env "Division by 0", Right (undefined)) maybeCalculate (Just (Number a)) (Just (Number b)) operator env = (env, Left (Just (calculate a b operator))) maybeCalculate _ _ _ env = (registerError env "Symbol not found", Right (undefined)) calculateOperator :: Env -> [Tree] -> Symbol -> (Env, Result) +calculateOperator env [_, Number 0] "div" = + (registerError env "Division by 0", Right (undefined)) calculateOperator env [Number a, Number b] operator = - (env, Left (Just (calculate a b operator))) + (env, Left (Just (calculate a b operator))) calculateOperator env [Number a, Symbol b] operator = - maybeCalculate (Just (Number a)) (evaluateSymbol env b) operator env + maybeCalculate (Just (Number a)) (evaluateSymbol env b) operator env calculateOperator env [Symbol a, Number b] operator = - maybeCalculate (evaluateSymbol env a) (Just (Number b)) operator env + maybeCalculate (evaluateSymbol env a) (Just (Number b)) operator env calculateOperator env [Symbol a, Symbol b] operator = - maybeCalculate (evaluateSymbol env a) (evaluateSymbol env b) operator env + maybeCalculate (evaluateSymbol env a) (evaluateSymbol env b) operator env calculateOperator env list _ | length list /= 2 = (registerError env "Addition need 2 params", Right (undefined)) diff --git a/test/Spec.hs b/test/Spec.hs index dda8eb8..bfd66e7 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -208,6 +208,10 @@ unitTestsComputeBasics = testGroup "Tests compute basics" assertEqual "2 + 3 * (8 + (5* ( 2 + 3))) = 107" (defaultEnv, [Left (Just (Number 101))]) (computeAllAST (defaultEnv) [(List [Symbol "+", Number 2, (List [Symbol "*", Number 3, (List [Symbol "+", Number 8, (List [Symbol "*", Number 5, (List [Symbol "+", Number 2, Number 3])])])])])]) + , testCase "div 42 0" $ + assertEqual "div 42 0" + (Env {defines = [], errors = ["Division by 0"], functions = []}, Right (undefined)) + (computeAST (defaultEnv) (List [Symbol "div", Number 42, Number 0])) ] unitTestsComputeFunctions :: TestTree From 82fb2d894f8106658b2e89849e24dc6e528b7bab Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 21:30:07 +0100 Subject: [PATCH 35/40] enhance defines --- src/Computing/ComputeAST.hs | 50 +++++++++++++++++++++++++++++++++++++ src/Computing/Defines.hs | 42 +------------------------------ test/Spec.hs | 8 ++++-- 3 files changed, 57 insertions(+), 43 deletions(-) diff --git a/src/Computing/ComputeAST.hs b/src/Computing/ComputeAST.hs index 9b93c8a..a919101 100644 --- a/src/Computing/ComputeAST.hs +++ b/src/Computing/ComputeAST.hs @@ -129,6 +129,56 @@ computeAstWithList env (List list) (newEnv, Just rvd) -> computeAST newEnv (List rvd) computeAstWithList env _ = (registerError env "Bad list", Right (undefined)) + +-- Register a define in the Defines list +registerDefine :: Env -> Symbol -> Tree -> Env +registerDefine env symb value@(Number _) = Env (defines env ++ [Define symb value]) (errors env) (functions env) +registerDefine env symb value@(Boolean _) = Env (defines env ++ [Define symb value]) (errors env) (functions env) +registerDefine env symb (List list) = case computeAST env (List list) of + (_, Left (Just result)) -> Env (defines env ++ [Define symb result]) (errors env) (functions env) + (newEnv, _) -> registerError newEnv "Bad define" +registerDefine env symb (Symbol smbl) = case getSymbolValue env smbl of + (_, Just result) -> Env (defines env ++ [Define symb result]) (errors env) (functions env) + (newEnv, _) -> registerError newEnv "Bad define" + +-- Add a function to the Functions list in the Env +addFunction :: Env -> String -> [String] -> [Tree] -> Env +addFunction env fnName fnParams fnBodies + = Env (defines env) (errors env) + (functions env ++ [Function fnName fnParams fnBodies]) + +-- Get params from a function +getParams :: Tree -> [String] +getParams (List []) = [] +getParams (List (Symbol smbl : xs)) = smbl : getParams (List xs) +getParams _ = [] + +-- Register a function in the Functions list +registerFunction :: Env -> Symbol -> Tree -> [Tree] -> Env +registerFunction env "" _ _ = + registerError env "function name must not be empty" +registerFunction env fnName fnParams fnBodies + = addFunction env fnName (getParams fnParams) fnBodies + +handleDefine :: Env -> Tree -> (Env, Result) +handleDefine env (List [Symbol _, Symbol smbl, + List (Symbol "lambda": List fnParams : fnBodies)]) = + (registerFunction env smbl (List fnParams) fnBodies, Left (Nothing)) +handleDefine env (List [Symbol _, + (List (Symbol smbl : fnParams)), List fnBodies]) = + (registerFunction env smbl (List fnParams) (List fnBodies : []), + Left (Nothing)) +handleDefine env (List [Symbol _, Symbol smbl, expr]) = + (registerDefine env smbl expr, Left (Nothing)) +handleDefine env _ = (registerError env "Bad define", Right (undefined)) + + + + + + + + computeAST :: Env -> Tree -> (Env, Result) computeAST env tree@(List (Symbol "define" : _)) = handleDefine env tree computeAST env tree@(List (List (Symbol "lambda" : _) : _)) = diff --git a/src/Computing/Defines.hs b/src/Computing/Defines.hs index f48f116..4371748 100644 --- a/src/Computing/Defines.hs +++ b/src/Computing/Defines.hs @@ -7,11 +7,7 @@ module Computing.Defines ( - registerDefine, - registerFunction, - getSymbolValue, - getParams, - handleDefine + getSymbolValue ) where import Types @@ -26,39 +22,3 @@ getSymbolValue (Env { defines = (Define smbl value):xs, (Env { defines = xs, errors = err, functions = fcts }, Just value) | otherwise = getSymbolValue (Env { defines = xs, errors = err, functions = fcts }) expr - --- Register a define in the Defines list -registerDefine :: Env -> Symbol -> Tree -> Env -registerDefine env symb value = - Env (defines env ++ [Define symb value]) (errors env) (functions env) - --- Add a function to the Functions list in the Env -addFunction :: Env -> String -> [String] -> [Tree] -> Env -addFunction env fnName fnParams fnBodies - = Env (defines env) (errors env) - (functions env ++ [Function fnName fnParams fnBodies]) - --- Get params from a function -getParams :: Tree -> [String] -getParams (List []) = [] -getParams (List (Symbol smbl : xs)) = smbl : getParams (List xs) -getParams _ = [] - --- Register a function in the Functions list -registerFunction :: Env -> Symbol -> Tree -> [Tree] -> Env -registerFunction env "" _ _ = - registerError env "function name must not be empty" -registerFunction env fnName fnParams fnBodies - = addFunction env fnName (getParams fnParams) fnBodies - -handleDefine :: Env -> Tree -> (Env, Result) -handleDefine env (List [Symbol _, Symbol smbl, - List (Symbol "lambda": List fnParams : fnBodies)]) = - (registerFunction env smbl (List fnParams) fnBodies, Left (Nothing)) -handleDefine env (List [Symbol _, - (List (Symbol smbl : fnParams)), List fnBodies]) = - (registerFunction env smbl (List fnParams) (List fnBodies : []), - Left (Nothing)) -handleDefine env (List [Symbol _, Symbol smbl, expr]) = - (registerDefine env smbl expr, Left (Nothing)) -handleDefine env _ = (registerError env "Bad define", Right (undefined)) diff --git a/test/Spec.hs b/test/Spec.hs index bfd66e7..3620b0b 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -150,12 +150,16 @@ unitTestsComputeDefines = testGroup "Tests Compute defines" (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "x", Number 42]), (List [Symbol "define", Symbol "y", Number 84]), (Symbol "x"), (Symbol "y")]) , testCase "define x (42 + 6); x" $ assertEqual "define x (42 + 6); x" - (Env {defines = [Define {symbol = "x", expression = List [Symbol "+", Number 42, Number 6]}], errors = [], functions = []}, [Left (Just (Number 48))]) + (Env {defines = [Define {symbol = "x", expression = Number 48}], errors = [], functions = []}, [Left (Just (Number 48))]) (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "x", (List [Symbol "+", Number 42, Number 6])]), (Symbol "x")]) , testCase "define foo (4 + 5); foo + foo" $ assertEqual "define foo (4 + 5); foo + foo" - (Env {defines = [Define {symbol = "foo", expression = List [Symbol "+", Number 4, Number 5]}], errors = [], functions = []}, [Left (Just (Number 18))]) + (Env {defines = [Define {symbol = "foo", expression = Number 9}], errors = [], functions = []}, [Left (Just (Number 18))]) (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", (List [Symbol "+", Number 4, Number 5])]), (List [Symbol "+", Symbol "foo", Symbol "foo"])]) + , testCase "define foo 42; define bar foo; bar + bar" $ + assertEqual "define foo 42; define bar foo; bar + bar" + (Env {defines = [Define {symbol = "foo", expression = Number 42}, Define {symbol = "bar", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 84))]) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "define", Symbol "bar", Symbol "foo"]), (List [Symbol "+", Symbol "bar", Symbol "bar"])]) ] unitTestsComputeSimpleFunctions :: TestTree From 5af97aa38780e300ad8c0c8df9988c6a8adecb3a Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 21:34:42 +0100 Subject: [PATCH 36/40] add define case "already defined" --- src/Computing/ComputeAST.hs | 13 ++++++------- src/Computing/Defines.hs | 13 ++++++++++++- test/Spec.hs | 4 ++++ 3 files changed, 22 insertions(+), 8 deletions(-) diff --git a/src/Computing/ComputeAST.hs b/src/Computing/ComputeAST.hs index a919101..5307c28 100644 --- a/src/Computing/ComputeAST.hs +++ b/src/Computing/ComputeAST.hs @@ -129,17 +129,16 @@ computeAstWithList env (List list) (newEnv, Just rvd) -> computeAST newEnv (List rvd) computeAstWithList env _ = (registerError env "Bad list", Right (undefined)) - -- Register a define in the Defines list registerDefine :: Env -> Symbol -> Tree -> Env -registerDefine env symb value@(Number _) = Env (defines env ++ [Define symb value]) (errors env) (functions env) -registerDefine env symb value@(Boolean _) = Env (defines env ++ [Define symb value]) (errors env) (functions env) +registerDefine env symb value@(Number _) = addDefineToEnv env symb value +registerDefine env symb value@(Boolean _) = addDefineToEnv env symb value registerDefine env symb (List list) = case computeAST env (List list) of - (_, Left (Just result)) -> Env (defines env ++ [Define symb result]) (errors env) (functions env) - (newEnv, _) -> registerError newEnv "Bad define" + (_, Left (Just result)) -> addDefineToEnv env symb result + (newEnv, _) -> registerError newEnv ("Bad define " ++ symb) registerDefine env symb (Symbol smbl) = case getSymbolValue env smbl of - (_, Just result) -> Env (defines env ++ [Define symb result]) (errors env) (functions env) - (newEnv, _) -> registerError newEnv "Bad define" + (_, Just result) -> addDefineToEnv env symb result + (newEnv, _) -> registerError newEnv ("Bad define " ++ symb) -- Add a function to the Functions list in the Env addFunction :: Env -> String -> [String] -> [Tree] -> Env diff --git a/src/Computing/Defines.hs b/src/Computing/Defines.hs index 4371748..2a9301c 100644 --- a/src/Computing/Defines.hs +++ b/src/Computing/Defines.hs @@ -7,7 +7,8 @@ module Computing.Defines ( - getSymbolValue + getSymbolValue, + addDefineToEnv ) where import Types @@ -22,3 +23,13 @@ getSymbolValue (Env { defines = (Define smbl value):xs, (Env { defines = xs, errors = err, functions = fcts }, Just value) | otherwise = getSymbolValue (Env { defines = xs, errors = err, functions = fcts }) expr + +isAlreadyDefined :: Env -> Symbol -> Bool +isAlreadyDefined env symb = symb `elem` map (\(Define s _) -> s) (defines env) + +addDefineToEnv :: Env -> Symbol -> Tree -> Env +addDefineToEnv env symb value + | isAlreadyDefined env symb = registerError env ("Symbol " ++ symb ++ + " is already defined") + | otherwise = Env (defines env ++ [Define symb value]) (errors env) + (functions env) diff --git a/test/Spec.hs b/test/Spec.hs index 3620b0b..4f623d2 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -160,6 +160,10 @@ unitTestsComputeDefines = testGroup "Tests Compute defines" assertEqual "define foo 42; define bar foo; bar + bar" (Env {defines = [Define {symbol = "foo", expression = Number 42}, Define {symbol = "bar", expression = Number 42}], errors = [], functions = []}, [Left (Just (Number 84))]) (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "define", Symbol "bar", Symbol "foo"]), (List [Symbol "+", Symbol "bar", Symbol "bar"])]) + , testCase "define foo 42; define foo 84" $ + assertEqual "define foo 42; define foo 84" + (Env {defines = [Define {symbol = "foo", expression = Number 42}], errors = ["Symbol foo is already defined"], functions = []}, []) + (computeAllAST (defaultEnv) [(List [Symbol "define", Symbol "foo", Number 42]), (List [Symbol "define", Symbol "foo", Number 84])]) ] unitTestsComputeSimpleFunctions :: TestTree From e8066fce47c62ea0ec919528f77cd7975b8e6ed8 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 21:42:49 +0100 Subject: [PATCH 37/40] fix norm --- src/Computing/ComputeAST.hs | 53 ++++++++++--------------------------- src/Computing/Defines.hs | 23 +++++++++++++++- 2 files changed, 36 insertions(+), 40 deletions(-) diff --git a/src/Computing/ComputeAST.hs b/src/Computing/ComputeAST.hs index 5307c28..0faf6ec 100644 --- a/src/Computing/ComputeAST.hs +++ b/src/Computing/ComputeAST.hs @@ -109,6 +109,19 @@ computeFunction env (Function fnName fnParams (x:_)) args = computeFunction env _ _ = (registerError env "Bad function call", Right (undefined)) +---------------------------- REGISTER DEFINE ---------------------------------- + +-- Register a define in the Defines list +registerDefine :: Env -> Symbol -> Tree -> Env +registerDefine env symb value@(Number _) = addDefineToEnv env symb value +registerDefine env symb value@(Boolean _) = addDefineToEnv env symb value +registerDefine env symb (List list) = case computeAST env (List list) of + (_, Left (Just result)) -> addDefineToEnv env symb result + (newEnv, _) -> registerError newEnv ("Bad define " ++ symb) +registerDefine env symb (Symbol smbl) = case getSymbolValue env smbl of + (_, Just result) -> addDefineToEnv env symb result + (newEnv, _) -> registerError newEnv ("Bad define " ++ symb) + --------------------------- COMPUTE AST ------------------------------------- computeASTWithoutList :: Env -> Tree -> (Env, Result) @@ -129,55 +142,17 @@ computeAstWithList env (List list) (newEnv, Just rvd) -> computeAST newEnv (List rvd) computeAstWithList env _ = (registerError env "Bad list", Right (undefined)) --- Register a define in the Defines list -registerDefine :: Env -> Symbol -> Tree -> Env -registerDefine env symb value@(Number _) = addDefineToEnv env symb value -registerDefine env symb value@(Boolean _) = addDefineToEnv env symb value -registerDefine env symb (List list) = case computeAST env (List list) of - (_, Left (Just result)) -> addDefineToEnv env symb result - (newEnv, _) -> registerError newEnv ("Bad define " ++ symb) -registerDefine env symb (Symbol smbl) = case getSymbolValue env smbl of - (_, Just result) -> addDefineToEnv env symb result - (newEnv, _) -> registerError newEnv ("Bad define " ++ symb) - --- Add a function to the Functions list in the Env -addFunction :: Env -> String -> [String] -> [Tree] -> Env -addFunction env fnName fnParams fnBodies - = Env (defines env) (errors env) - (functions env ++ [Function fnName fnParams fnBodies]) - --- Get params from a function -getParams :: Tree -> [String] -getParams (List []) = [] -getParams (List (Symbol smbl : xs)) = smbl : getParams (List xs) -getParams _ = [] - --- Register a function in the Functions list -registerFunction :: Env -> Symbol -> Tree -> [Tree] -> Env -registerFunction env "" _ _ = - registerError env "function name must not be empty" -registerFunction env fnName fnParams fnBodies - = addFunction env fnName (getParams fnParams) fnBodies - handleDefine :: Env -> Tree -> (Env, Result) handleDefine env (List [Symbol _, Symbol smbl, List (Symbol "lambda": List fnParams : fnBodies)]) = (registerFunction env smbl (List fnParams) fnBodies, Left (Nothing)) handleDefine env (List [Symbol _, (List (Symbol smbl : fnParams)), List fnBodies]) = - (registerFunction env smbl (List fnParams) (List fnBodies : []), - Left (Nothing)) + (registerFunction env smbl (List fnParams) (List fnBodies : []), Left (Nothing)) handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl expr, Left (Nothing)) handleDefine env _ = (registerError env "Bad define", Right (undefined)) - - - - - - - computeAST :: Env -> Tree -> (Env, Result) computeAST env tree@(List (Symbol "define" : _)) = handleDefine env tree computeAST env tree@(List (List (Symbol "lambda" : _) : _)) = diff --git a/src/Computing/Defines.hs b/src/Computing/Defines.hs index 2a9301c..abc69fa 100644 --- a/src/Computing/Defines.hs +++ b/src/Computing/Defines.hs @@ -8,7 +8,9 @@ module Computing.Defines ( getSymbolValue, - addDefineToEnv + addDefineToEnv, + registerFunction, + getParams ) where import Types @@ -33,3 +35,22 @@ addDefineToEnv env symb value " is already defined") | otherwise = Env (defines env ++ [Define symb value]) (errors env) (functions env) + +-- Add a function to the Functions list in the Env +addFunction :: Env -> String -> [String] -> [Tree] -> Env +addFunction env fnName fnParams fnBodies + = Env (defines env) (errors env) + (functions env ++ [Function fnName fnParams fnBodies]) + +-- Get params from a function +getParams :: Tree -> [String] +getParams (List []) = [] +getParams (List (Symbol smbl : xs)) = smbl : getParams (List xs) +getParams _ = [] + +-- Register a function in the Functions list +registerFunction :: Env -> Symbol -> Tree -> [Tree] -> Env +registerFunction env "" _ _ = + registerError env "function name must not be empty" +registerFunction env fnName fnParams fnBodies + = addFunction env fnName (getParams fnParams) fnBodies From ef4edff8fba2eec25fd157b351d1d25af09e2705 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 21:48:57 +0100 Subject: [PATCH 38/40] remove useless coma --- src/Computing/ComputeAST.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Computing/ComputeAST.hs b/src/Computing/ComputeAST.hs index 0faf6ec..61c2035 100644 --- a/src/Computing/ComputeAST.hs +++ b/src/Computing/ComputeAST.hs @@ -7,7 +7,7 @@ module Computing.ComputeAST ( - computeAST, + computeAST ) where import Types From 16d4ed6ba48e4ea5555215b753e058fcbbdabe86 Mon Sep 17 00:00:00 2001 From: tenshi Date: Sun, 17 Dec 2023 21:50:14 +0100 Subject: [PATCH 39/40] fix norm --- src/Computing/ComputeAST.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Computing/ComputeAST.hs b/src/Computing/ComputeAST.hs index 61c2035..64cb53e 100644 --- a/src/Computing/ComputeAST.hs +++ b/src/Computing/ComputeAST.hs @@ -148,7 +148,8 @@ handleDefine env (List [Symbol _, Symbol smbl, (registerFunction env smbl (List fnParams) fnBodies, Left (Nothing)) handleDefine env (List [Symbol _, (List (Symbol smbl : fnParams)), List fnBodies]) = - (registerFunction env smbl (List fnParams) (List fnBodies : []), Left (Nothing)) + (registerFunction env smbl (List fnParams) + (List fnBodies : []), Left (Nothing)) handleDefine env (List [Symbol _, Symbol smbl, expr]) = (registerDefine env smbl expr, Left (Nothing)) handleDefine env _ = (registerError env "Bad define", Right (undefined)) From 48270870426bd917d2956a93203a8f6b160ed3e0 Mon Sep 17 00:00:00 2001 From: Xavier Mitault Date: Sun, 17 Dec 2023 23:31:45 +0100 Subject: [PATCH 40/40] Change version --- src/KoakyLibVersion.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/KoakyLibVersion.hs b/src/KoakyLibVersion.hs index 7f4d84c..9fc9a5b 100644 --- a/src/KoakyLibVersion.hs +++ b/src/KoakyLibVersion.hs @@ -18,7 +18,7 @@ koakyLibVersionPatch :: Int koakyLibVersionPatch = 0 koakyLibVersionMinor :: Int -koakyLibVersionMinor = 0 +koakyLibVersionMinor = 4 koakyLibVersionMajor :: Int koakyLibVersionMajor = 0