diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Builtins.hs | 11 | ||||
| -rw-r--r-- | src/Interpreter.hs | 41 | ||||
| -rw-r--r-- | src/Parser.hs | 18 |
3 files changed, 54 insertions, 16 deletions
diff --git a/src/Builtins.hs b/src/Builtins.hs index 511ef08..4ac6598 100644 --- a/src/Builtins.hs +++ b/src/Builtins.hs @@ -27,6 +27,7 @@ builtinEnv = M.fromList $ map (B.second Regular) [ builtinParseInt, builtinParseFloat, builtinStrToVec, + builtinHashMap, -- sequence (vector, string) operations builtinSeqHead, builtinSeqTail, @@ -60,7 +61,8 @@ builtinEnv = M.fromList $ map (B.second Regular) [ reservedKeyword "Debug/env", reservedKeyword "import", reservedKeyword "record", - reservedKeyword "do" + reservedKeyword "do", + reservedKeyword "eval" ] argError1 :: String -> AST -> String @@ -309,6 +311,13 @@ builtinStrToVec = (name, makeNonsenseAST $ ASTFunction Pure fn1) where .> return fn1 ast1 = throwL (astPos ast1, argError1 name ast1) +builtinHashMap :: (String, AST) +builtinHashMap = (name, makeNonsenseAST $ ASTFunction Pure fn1) where + name = "hash-map" + fn1 AST { an = ASTVector vec } = + return $ makeNonsenseAST $ ASTHashMap $ M.fromList $ asPairs vec + fn1 ast1 = throwL (astPos ast1, argError1 name ast1) + builtinPrint :: (String, AST) builtinPrint = (name, makeNonsenseAST $ ASTFunction Impure fn1) where name = "print!" diff --git a/src/Interpreter.hs b/src/Interpreter.hs index c899524..9362d91 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -111,7 +111,16 @@ evaluateFunctionDef fPurity asts = do throwL (astPos defAst, "\\ or \\! called with " ++ show (length args) ++ " arguments") | otherwise -> return $ (head args', tail args') - AST { an = ASTVector params' } <- assertIsASTVector params'' + params' <- case params'' of + AST { an = ASTVector vec } -> return vec + -- vector literals like [a b c] are turned into (eval [a b c]) in the parser, and this eval call + -- must be unwrapped. this is not the cleanest way to do this but this way we can avoid having special + -- evaluation logic for collection types. + AST { an = ASTFunctionCall ([ AST { an = ASTSymbol "eval" }, AST { an = ASTVector vec }])} + -> return vec + other -> throwL (astPos params'', + "non-vector value used as parameter list in function definition: " ++ show other) + params <- mapM assertIsASTSymbol params' env <- getEnv @@ -414,6 +423,26 @@ evaluateDo children = do evaluate retExpr +evaluateImmediateEval :: [AST] -> LContext AST +evaluateImmediateEval children = do + let fnAst = head children + args = tail children + + when (length args /= 1) $ throwL (astPos fnAst, "eval called with invalid number of arguments: " ++ show (length args)) + case head args of + ast@AST { an = ASTVector vec } -> do + rets <- mapM evaluate vec `catchError` + appendError (astPos ast, "when evaluating elements of vector") + return $ ast { an = ASTVector rets } + ast@AST { an = ASTHashMap hmap } -> do + let pairs = M.assocs hmap + evaledPairs <- mapM (\(k, v) -> do evaledK <- evaluate k + evaledV <- evaluate v + return (evaledK, evaledV)) pairs `catchError` + appendError (astPos ast, "when evaluating keys and values of hash map") + return $ ast { an = ASTHashMap $ M.fromList evaledPairs } + arg -> evaluate arg + evaluate :: AST -> LContext AST evaluate ast@AST { an = fnc@(ASTFunctionCall args@(x:_)) } = do config <- getConfig @@ -440,6 +469,8 @@ evaluate ast@AST { an = fnc@(ASTFunctionCall args@(x:_)) } = evaluateRecord args ASTSymbol "do" -> evaluateDo args + ASTSymbol "eval" -> + evaluateImmediateEval args _ -> evaluateFunctionCall args @@ -452,12 +483,6 @@ evaluate ast@AST { an = fnc@(ASTFunctionCall args@(x:_)) } = return ret evaluate ast@AST { an = (ASTSymbol _) } = evaluateSymbol ast -evaluate ast@AST { an = (ASTVector vec) } = - do incrementDepth - rets <- mapM evaluate vec `catchError` - appendError (astPos ast, "when evaluating elements of vector") - decrementDepth - return $ ast { an = ASTVector rets } evaluate other = return other @@ -509,4 +534,4 @@ runInlineScript' lineNo fileName src = do PrintEvaledOff -> return () restEvaled <- foldEvaluate rest - return $ evaledAst : restEvaled + return $ evaledAst : restEvaled
\ No newline at end of file diff --git a/src/Parser.hs b/src/Parser.hs index 5e94148..3c2350c 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -2,11 +2,9 @@ module Parser ( parse, ) where -import qualified Data.Map as M import qualified Data.List as L import qualified Data.Maybe as MB import Control.Monad.State -import Control.Monad.Except import Text.Regex.TDFA import Utils @@ -64,16 +62,22 @@ _parse acc (Token { tokenContent = "]" }:rest) = do let children' = takeWhile (an .> (/= ASTSymbol "[")) acc children <- validateBalance ["["] children' let openBracket = MB.fromJust $ L.find (an .> (== ASTSymbol "[")) acc - let vec = openBracket { an = ASTVector (reverse children) } - let newAcc = vec : drop (length children + 1) acc + let evalSym = makeNonsenseAST $ ASTSymbol "eval" + let evalArg = makeNonsenseAST $ ASTVector $ reverse children + let evalCall = openBracket { an = ASTFunctionCall [evalSym, evalArg] } + let newAcc = evalCall : drop (length children + 1) acc _parse newAcc rest _parse acc (Token { tokenContent = "}" }:rest) = do let children' = takeWhile (an .> (/= ASTSymbol "{")) acc children <- validateBalance ["{"] children' + when (length children `mod` 2 /= 0) $ throwL ("", "odd number of elements in hash map literal") let openCurly = MB.fromJust $ L.find (an .> (== ASTSymbol "{")) acc - pairs <- asPairsM (reverse children) `catchError` appendError (astPos openCurly, "when parsing a hash map") - let hmap = openCurly { an = ASTHashMap (M.fromList pairs) } - let newAcc = hmap : drop (length children + 1) acc + let evalSym = makeNonsenseAST $ ASTSymbol "eval" + let evalArg = makeNonsenseAST $ ASTVector $ reverse children + let hashMapSym = makeNonsenseAST $ ASTSymbol "hash-map" + let hashMapArg = makeNonsenseAST $ ASTFunctionCall [evalSym, evalArg] + let hashMapCall = openCurly { an = ASTFunctionCall [hashMapSym, hashMapArg]} + let newAcc = hashMapCall : drop (length children + 1) acc _parse newAcc rest _parse acc (token:rest) = _parse (parseToken token : acc) rest |