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