module Language.Egison.Variables where
import Language.Egison.Types
import Control.Monad.Error
import Data.IORef
import qualified Data.Map
printEnv :: Env
-> IO String
printEnv env = do
bindings <- liftIO $ readIORef $ topFrameRef env
l <- mapM showBind $ Data.Map.toList bindings
return $ unlines l
where
showBind ((name, nums), objRef) = do
obj <- liftIO $ readIORef objRef
return $ name ++ unwordsNums nums ++ ": " ++ show obj
copyEnv :: Env
-> IO Env
copyEnv env = do
bindings <- liftIO $ readIORef $ topFrameRef env
bindingListT <- mapM addBinding $ Data.Map.toList bindings
bindingList <- newIORef $ Data.Map.fromList bindingListT
return $ Environment (parentEnv env) bindingList
where addBinding (var, val) = do
x <- liftIO $ readIORef val
ref <- newIORef x
return (var, ref)
extendEnv :: Env
-> [(Var, ObjectRef)]
-> IO Env
extendEnv env abindings = do bindinglist <- newIORef $ Data.Map.fromList abindings
return $ Environment (Just env) bindinglist
makeLetRecFrame :: Env
-> [(String, EgisonExpr)]
-> IO FrameRef
makeLetRecFrame env abindings = do
newEnv <- extendLetRec env abindings
return $ topFrameRef newEnv
extendLetRec :: Env
-> [(String, EgisonExpr)]
-> IO Env
extendLetRec env abindings = do
bindinglistT <- (mapM addDummyBinding abindings)
bindinglist <- newIORef $ Data.Map.fromList $ map (\(name,objRef) -> ((name,[]),objRef)) bindinglistT
let newEnv = Environment (Just env) bindinglist
mapM (replaceWithNewEnv newEnv) bindinglistT
return newEnv
where addDummyBinding (name, expr) = do dummy <- nullEnv
objRef <- makeClosure dummy expr
return (name, objRef)
replaceWithNewEnv newEnv (_, objRef) = do obj <- readIORef objRef
case obj of
Closure _ cExpr -> writeIORef objRef (Closure newEnv cExpr)
findEnv
:: Env
-> Var
-> IO (Maybe Env)
findEnv envRef var = do
found <- liftIO $ isBound envRef var
if found
then return (Just envRef)
else case parentEnv envRef of
(Just par) -> findEnv par var
Nothing -> return Nothing
isBound
:: Env
-> Var
-> IO Bool
isBound envRef var =
(readIORef $ topFrameRef envRef) >>= return . Data.Map.member var
isRecBound
:: Env
-> Var
-> IO Bool
isRecBound envRef var = do
env <- findEnv envRef var
case env of
(Just e) -> isBound e var
Nothing -> return False
getVarFromFrame :: Frame -> Var -> IOThrowsError ObjectRef
getVarFromFrame frame var = do
case Data.Map.lookup var frame of
(Just a) -> return a
Nothing -> throwError $ UnboundVar "Getting an unbound variable" (showVar var)
getVar :: Env
-> Var
-> IOThrowsError ObjectRef
getVar envRef
var = do binds <- liftIO $ readIORef $ topFrameRef envRef
case Data.Map.lookup var binds of
(Just a) -> return a
Nothing -> case parentEnv envRef of
(Just par) -> getVar par var
Nothing -> (throwError $ UnboundVar "Getting an unbound variable" (showVar var))
defineVar
:: Env
-> Var
-> ObjectRef
-> IOThrowsError ()
defineVar envRef
var objRef = do
liftIO $ do
env <- readIORef $ topFrameRef envRef
writeIORef (topFrameRef envRef) (Data.Map.insert var objRef env)
return ()