aboutsummaryrefslogtreecommitdiffstats
path: root/src/Lib.hs
diff options
context:
space:
mode:
authorJan Tuomi <jan.tuomi@valuemotive.com>2022-09-23 17:27:42 +0300
committerJan Tuomi <jans.tuomi@gmail.com>2022-12-05 14:21:53 +0200
commit412082729551dffdcbce7e28f6209d1cd809155f (patch)
treebd09e17ff957e2b111ffbe40eedf7282fc2e2567 /src/Lib.hs
parent2c67ae5a703eb19479c131b5488d846a9c84a550 (diff)
Add special function handling
Diffstat (limited to 'src/Lib.hs')
-rw-r--r--src/Lib.hs36
1 files changed, 29 insertions, 7 deletions
diff --git a/src/Lib.hs b/src/Lib.hs
index a5dcaa6..b5c66e3 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -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