module Language.Scheme.Variables where
import Language.Scheme.Types
import Control.Monad.Error
import Data.IORef
extendEnv :: Env -> [((String, String), LispVal)] -> IO Env
extendEnv envRef bindings = do bindinglist <- mapM (\((namespace, name), val) ->
do ref <- newIORef val
return ((namespace, name), ref)) bindings
>>= newIORef
return $ Environment (Just envRef) bindinglist
isBound :: Env -> String -> IO Bool
isBound envRef var = isNamespacedBound envRef varNamespace var
isNamespacedBound :: Env -> String -> String -> IO Bool
isNamespacedBound envRef namespace var = (readIORef $ bindings envRef) >>= return . maybe False (const True) . lookup (namespace, var)
getVar :: Env -> String -> IOThrowsError LispVal
getVar envRef var = getNamespacedVar envRef varNamespace var
getNamespacedVar :: Env -> String -> String -> IOThrowsError LispVal
getNamespacedVar envRef
namespace
var = do binds <- liftIO $ readIORef $ bindings envRef
case lookup (namespace, var) binds of
(Just a) -> liftIO $ readIORef a
Nothing -> case parentEnv envRef of
(Just par) -> getNamespacedVar par namespace var
Nothing -> (throwError $ UnboundVar "Getting an unbound variable" var)
setVar, defineVar :: Env -> String -> LispVal -> IOThrowsError LispVal
setVar envRef var value = setNamespacedVar envRef varNamespace var value
defineVar envRef var value = defineNamespacedVar envRef varNamespace var value
setNamespacedVar :: Env -> String -> String -> LispVal -> IOThrowsError LispVal
setNamespacedVar envRef
namespace
var value = do env <- liftIO $ readIORef $ bindings envRef
case lookup (namespace, var) env of
(Just a) -> do
liftIO $ writeIORef a value
return value
Nothing -> case parentEnv envRef of
(Just par) -> setNamespacedVar par namespace var value
Nothing -> throwError $ UnboundVar "Setting an unbound variable: " var
defineNamespacedVar :: Env -> String -> String -> LispVal -> IOThrowsError LispVal
defineNamespacedVar envRef
namespace
var value = do
alreadyDefined <- liftIO $ isNamespacedBound envRef namespace var
if alreadyDefined
then setNamespacedVar envRef namespace var value >> return value
else liftIO $ do
valueRef <- newIORef value
env <- readIORef $ bindings envRef
writeIORef (bindings envRef) (((namespace, var), valueRef) : env)
return value