diff options
| author | Jan Tuomi <jan.tuomi@valuemotive.com> | 2022-09-23 17:27:42 +0300 |
|---|---|---|
| committer | Jan Tuomi <jans.tuomi@gmail.com> | 2022-12-05 14:21:53 +0200 |
| commit | 412082729551dffdcbce7e28f6209d1cd809155f (patch) | |
| tree | bd09e17ff957e2b111ffbe40eedf7282fc2e2567 /src | |
| parent | 2c67ae5a703eb19479c131b5488d846a9c84a550 (diff) | |
Add special function handling
Diffstat (limited to 'src')
| -rw-r--r-- | src/Lib.hs | 36 |
1 files changed, 29 insertions, 7 deletions
@@ -138,7 +138,8 @@ curryCall (arg:rest) f = do type Env = M.Map String AST builtinEnv :: Env builtinEnv = M.fromList [ - ("sum2", builtinSum2) + ("sum2", builtinSum2), + ("\\", builtinFunctionDef) ] builtinSum2 :: AST @@ -151,13 +152,34 @@ builtinSum2 = return $ ASTFunction $ inner in ASTFunction outer +builtinFunctionDef :: AST +builtinFunctionDef = + let fn :: AST -> LContext AST + fn (ASTVector (ASTVector fnArgs : ASTFunctionCall body : [])) + = error $ "todo function define" + fn _ = error "unreachable" + in ASTFunction fn + +-- Special functions are not curried and might not evaluate their args +isSpecialFunctionCall :: [AST] -> Bool +isSpecialFunctionCall [] = error $ "unreachable" +isSpecialFunctionCall (first:_) = + let specialFunctions = ["\\", "match"] + in case first of + ASTSymbol s -> s `elem` specialFunctions + _ -> False + evaluate :: Env -> AST -> LContext AST -evaluate env (ASTFunctionCall (first:args)) = do - fnEvaled <- evaluate env first - (ASTFunction fn) <- assertFunctionAST fnEvaled - evaledArgs <- mapM (evaluate env) args - result <- curryCall (reverse evaledArgs) fn - return result +evaluate env (ASTFunctionCall children@(first:args)) + | isSpecialFunctionCall children = do + (ASTFunction fn) <- evaluate env first + fn $ ASTVector args + | otherwise = do + fnEvaled <- evaluate env first + (ASTFunction fn) <- assertFunctionAST fnEvaled + evaledArgs <- mapM (evaluate env) args + result <- curryCall (reverse evaledArgs) fn + return result evaluate env (ASTSymbol sym) = do let val = M.lookup sym env case val of |
