diff options
| -rw-r--r-- | app/Main.hs | 2 | ||||
| -rw-r--r-- | src/Builtins.hs | 2 | ||||
| -rw-r--r-- | src/Interpreter.hs | 28 | ||||
| -rw-r--r-- | src/Utils.hs | 36 |
4 files changed, 19 insertions, 49 deletions
diff --git a/app/Main.hs b/app/Main.hs index 35ca77d..1617dd5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -60,7 +60,7 @@ main = do let config = parseArgs initialConfig args ls = LState { stateConfig = config, - stateEnv = emptyEnv { envImported = builtinEnv }, + stateEnv = builtinEnv, stateDepth = 0, statePure = Impure } diff --git a/src/Builtins.hs b/src/Builtins.hs index 95fe27c..5ecf24d 100644 --- a/src/Builtins.hs +++ b/src/Builtins.hs @@ -8,7 +8,7 @@ import qualified Data.List as L import Control.Monad.Except import Utils -builtinEnv :: EnvMap +builtinEnv :: Env builtinEnv = M.fromList [ -- arithmetic builtinAdd2, diff --git a/src/Interpreter.hs b/src/Interpreter.hs index 524fb82..d77840d 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -184,7 +184,7 @@ evaluateLet asts = do (symbol, value) <- letArgsToSymValPairs args env <- getEnv when (MB.isJust $ resolveSymbol symbol env) $ throwL (astPos letAst) $ "symbol already defined: " ++ symbol - insertThisEnv symbol value + insertEnv symbol value return $ letAst { astNode = ASTUnit } evaluateDebugEnv :: [AST] -> LContext AST @@ -192,7 +192,7 @@ evaluateDebugEnv asts = do let envAst = head asts env <- getEnv - let pairs = M.assocs (M.union (envThis env) (envImported env)) + let pairs = M.assocs env let longestKey = L.maximumBy (compare `on` (length . fst)) pairs $> fst let pad s = s ++ take (length longestKey + 4 - length s) (L.repeat ' ') let rows = pairs $> map (\(k, v) -> pad k ++ show v) @@ -212,7 +212,7 @@ evaluateImport asts = do let initialState = LState { stateConfig = config, stateDepth = 0, - stateEnv = emptyEnv { envImported = builtinEnv }, + stateEnv = builtinEnv, statePure = Impure } case args of @@ -221,12 +221,10 @@ evaluateImport asts = do let checkedPath = if (not $ ".milch" `L.isSuffixOf` path) then (path ++ ".milch") else path - LState { stateEnv = evaledRawEnv } <- lift $ execStateT (runScriptFile checkedPath) initialState - let exportedEnvMap = envThis evaledRawEnv - + LState { stateEnv = importedEnv } <- lift $ execStateT (runScriptFile checkedPath) initialState env <- getEnv - let importedEnv = envImported env - putImportedEnv $ M.union importedEnv exportedEnvMap + + putEnv $ M.union importedEnv env return $ importAst { astNode = ASTUnit } _ -> throwL (astPos importAst) $ "invalid arguments passed to import: " ++ show args @@ -263,14 +261,14 @@ evaluateRecord asts = do makeFnCreate _ _ = error $ "unreachable: makeFnCreate " ++ fnCreateName let createFn = makeFnCreate fields [] - insertThisEnv fnCreateName $ recordAst { astNode = ASTFunction Pure createFn } + insertEnv fnCreateName $ recordAst { astNode = ASTFunction Pure createFn } let makeGetFns [] = return $ () makeGetFns (param:restParams) = do let fnGetName = ns ++ "/" ++ "get-" ++ param let fn = getFn fnGetName let fnAST = makeNonsenseAST $ ASTFunction Pure $ fn - insertThisEnv fnGetName fnAST + insertEnv fnGetName fnAST makeGetFns restParams makeGetFns fields @@ -280,7 +278,7 @@ evaluateRecord asts = do let fnSetName = ns ++ "/" ++ "set-" ++ param let fn = setFn fnSetName let fnAST = makeNonsenseAST $ ASTFunction Pure $ fn - insertThisEnv fnSetName fnAST + insertEnv fnSetName fnAST makeSetFns restParams makeSetFns fields @@ -333,13 +331,7 @@ evaluateUserFunction children = do return $ fnAst { astNode = astNode result } resolveSymbol :: String -> Env -> Maybe AST -resolveSymbol sym Env { envThis = envThis, envImported = envImported } - | (MB.isJust $ thisValM) = thisValM - | (MB.isJust $ importedValM) = importedValM - | otherwise = Nothing - where - thisValM = M.lookup sym envThis - importedValM = M.lookup sym envImported +resolveSymbol = M.lookup evaluateSymbol :: AST -> LContext AST evaluateSymbol ast@AST { astNode = ASTSymbol sym } = do diff --git a/src/Utils.hs b/src/Utils.hs index 7752a5f..785c644 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -30,18 +30,7 @@ data Config = Config { configUseREPL :: Bool } -type EnvMap = M.Map String AST - -data Env = Env { - envThis :: EnvMap, - envImported :: EnvMap -} - -emptyEnv :: Env -emptyEnv = Env { - envThis = M.empty, - envImported = M.empty -} +type Env = M.Map String AST data LState = LState { stateConfig :: Config, @@ -67,25 +56,14 @@ getConfig = do s <- get return $ stateConfig s -putThisEnv :: EnvMap -> LContext () -putThisEnv env = do - modify (\s -> let prevEnv = stateEnv s - in s { stateEnv = prevEnv { envThis = env } }) - -putImportedEnv :: EnvMap -> LContext () -putImportedEnv env = do - modify (\s -> let prevEnv = stateEnv s - in s { stateEnv = prevEnv { envImported = env } }) - -insertThisEnv :: String -> AST -> LContext () -insertThisEnv k v = do - env <- getEnv - putThisEnv $ M.insert k v (envThis env) +putEnv :: Env -> LContext () +putEnv env = do + modify (\s -> s { stateEnv = env }) -insertImportedEnv :: String -> AST -> LContext () -insertImportedEnv k v = do +insertEnv :: String -> AST -> LContext () +insertEnv k v = do env <- getEnv - putThisEnv $ M.insert k v (envImported env) + putEnv $ M.insert k v env incrementDepth :: LContext () incrementDepth = |