Commit | Line | Data |
---|---|---|
b76aa73b | 1 | module Env |
2988d38e | 2 | ( Env, env_new, null_env, env_bind, env_find, env_get, env_set ) |
b76aa73b JM |
3 | where |
4 | ||
5 | import Data.IORef (IORef, newIORef, readIORef, writeIORef) | |
6 | import Control.Monad.Trans (liftIO) | |
7 | import Data.List (elemIndex) | |
8 | import qualified Data.Map as Map | |
9 | ||
10 | import Types | |
11 | import Printer | |
12 | ||
fa9a9758 JM |
13 | -- These Env types are defined in Types module to avoid dep cycle |
14 | --data EnvData = EnvPair (Maybe Env, (Map.Map String MalVal)) | |
15 | --type Env = IORef EnvData | |
b76aa73b JM |
16 | |
17 | env_new :: Maybe Env -> IO Env | |
18 | env_new outer = newIORef $ EnvPair (outer, (Map.fromList [])) | |
19 | ||
20 | null_env = env_new Nothing | |
21 | ||
22 | env_bind :: Env -> [MalVal] -> [MalVal] -> IO Env | |
fa9a9758 | 23 | env_bind envRef binds exprs = do |
b76aa73b | 24 | case (elemIndex (MalSymbol "&") binds) of |
fa9a9758 JM |
25 | Nothing -> do |
26 | -- bind binds to exprs | |
27 | _ <- mapM (\(b,e) -> env_set envRef b e) $ zip binds exprs | |
28 | return envRef | |
29 | Just idx -> do | |
30 | -- Varargs binding | |
31 | _ <- mapM (\(b,e) -> env_set envRef b e) $ | |
32 | zip (take idx binds) (take idx exprs) | |
33 | _ <- env_set envRef (binds !! (idx + 1)) | |
c150ec41 | 34 | (MalList (drop idx exprs) Nil) |
fa9a9758 | 35 | return envRef |
b76aa73b | 36 | |
b76aa73b JM |
37 | env_find :: Env -> MalVal -> IO (Maybe Env) |
38 | env_find envRef sym@(MalSymbol key) = do | |
39 | e <- readIORef envRef | |
40 | case e of | |
41 | EnvPair (o, m) -> case Map.lookup key m of | |
42 | Nothing -> case o of | |
43 | Nothing -> return Nothing | |
44 | Just o -> env_find o sym | |
45 | Just val -> return $ Just envRef | |
46 | ||
5400d4bf | 47 | env_get :: Env -> MalVal -> IOThrows MalVal |
b76aa73b JM |
48 | env_get envRef sym@(MalSymbol key) = do |
49 | e1 <- liftIO $ env_find envRef sym | |
50 | case e1 of | |
5400d4bf | 51 | Nothing -> throwStr $ "'" ++ key ++ "' not found" |
b76aa73b JM |
52 | Just eRef -> do |
53 | e2 <- liftIO $ readIORef eRef | |
54 | case e2 of | |
55 | EnvPair (o,m) -> case Map.lookup key m of | |
5400d4bf | 56 | Nothing -> throwStr $ "env_get error" |
b76aa73b JM |
57 | Just val -> return val |
58 | ||
59 | ||
60 | env_set :: Env -> MalVal -> MalVal -> IO MalVal | |
61 | env_set envRef (MalSymbol key) val = do | |
62 | e <- readIORef envRef | |
63 | case e of | |
64 | EnvPair (o,m) -> writeIORef envRef $ EnvPair (o, (Map.insert key val m)) | |
65 | return val |