Hazel Levine 8 months ago
parent
commit
7d7162c886
2 changed files with 73 additions and 0 deletions
  1. +61
    -0
      src/Scheme/Env.hs
  2. +12
    -0
      stack.yaml.lock

+ 61
- 0
src/Scheme/Env.hs View File

@ -0,0 +1,61 @@
{-# LANGUAGE OverloadedStrings, ExistentialQuantification #-}
module Scheme.Env
( Env
, nullEnv
, liftThrows
, runIOThrows
, getVar
, setVar
, defineVar
, isBound )
where
type Env = IORef [(String, IORef LispVal)]
type IOThrowsError = ExceptT LispError IO
import Data.Text (Text)
import qualified Data.Text as T
import Data.Complex
import Data.Ratio
import Control.Monad.Except
import Data.IORef
import Control.Applicative
import Scheme.Error
nullEnv :: IO Env
nullEnv = newIORef []
liftThrows :: ThrowsError a -> IOThrowsError a
liftThrows (Left err) = throwError err
liftThrows (Right val) = return val
runIOThrows :: IOThrowsError String -> IO String
runIOThrows act = runExceptT (trapError act) >>= return . extractValue
isBound :: Env -> String -> IO Bool
isBound envRef var = readIORef envRef >>= return . maybe False (const True) . lookup var
getVar :: Env -> String -> IOThrowsError LispVal
getVar envRef var = do env <- liftIO $ readIORef envRef
maybe (throwError $ UnboundVar "Attempting to get unbound variable" var)
(liftIO . readIORef)
(lookup var env)
setVar :: Env -> String -> LispVal -> IOThrowsError LispVal
setVar envRef var value = do env <- liftIO $ readIORef envRef
maybe (throwError $ UnboundVar "Attempting to get unbound variable" var)
(liftIO . (flip writeIORef value))
(lookup var env)
return value
defineVar :: Env -> String -> LispVal -> IOThrowsError LispVal
defineVar envRef var value = do
alreadyDefined <- liftIO $ isBound envRef var
if alreadyDefined
then setVar envRef var value >> return value
else liftIO $ do valueRef <- newIORef value
env <- readIORef envRef
_ <- writeIORef envRef ((var, valueRef):env)
return value

+ 12
- 0
stack.yaml.lock View File

@ -0,0 +1,12 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages: []
snapshots:
- completed:
size: 535256
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/9/3.yaml
sha256: 124a1da64177db7c1a46cb127f2ad8ba8e2c5dde0abeafe445fdacc61e723278
original: lts-9.3

Loading…
Cancel
Save