Permalink
Browse files

Started trying to use Data.Map.Maps as Envs, but not having much luck…

…. It doesn't even compile right now :(
  • Loading branch information...
1 parent e169bbe commit 663350e6c67c761326dce61687aa580041494838 @TikhonJelvis committed Feb 11, 2012
Showing with 13 additions and 9 deletions.
  1. +1 −1 TPL.cabal
  2. +6 −5 src/TPL/Env.hs
  3. +6 −3 src/TPL/Value.hs
View
@@ -45,7 +45,7 @@ Build-type: Simple
Cabal-version: >=1.9.2
Library
- Build-depends: base, parsec >= 3, mtl
+ Build-depends: base, containers, parsec >= 3, mtl
Hs-source-dirs: src
Exposed-modules: TPL.Coerce, TPL.Env, TPL.Error, TPL.Eval, TPL.Native,
TPL.Parse, TPL.Pattern, TPL.Run, TPL.Syntax, TPL.Value
View
@@ -3,23 +3,24 @@ module TPL.Env (get, set, define, bindVars, getPrecedence, setPrecedence) where
import Control.Applicative
import Control.Monad.Error
+import qualified Data.Map as M
import Data.Maybe
import Data.IORef
import TPL.Error
import TPL.Value
exists :: Env -> String -> IO Bool
-exists env name = isJust . lookup name <$> readIORef env
+exists env name = M.member name <$> readIORef env
und :: String -> IOThrowsError TPLValue
und = throwError . UndefinedVariable
get :: Env -> String -> IOThrowsError TPLValue
-get env name = liftIO (lookup name <$> readIORef env) >>= maybe (und name) (liftIO . readIORef)
-
+get env name = M.lookup name <$> liftIO (readIORef env) >>= maybe (und name) return
+
set :: Env -> String -> TPLValue -> IOThrowsError TPLValue
-set env name val = liftIO (lookup name <$> readIORef env) >>= maybe (und name)
+set env name val = liftIO (M.lookup name <$> readIORef env) >>= maybe (und name)
(\ ref -> liftIO $ writeIORef ref val >> return val)
define :: Env -> String -> TPLValue -> IOThrowsError TPLValue
@@ -28,7 +29,7 @@ define env name val = do bound <- liftIO (exists env name)
then set env name val >> return ()
else liftIO $ do value <- newIORef val
currEnv <- readIORef env
- writeIORef env $ (name, value) : currEnv
+ writeIORef env $ M.insert name val currEnv
return val
bindVars :: Env -> [(String, TPLValue)] -> IO Env
View
@@ -2,11 +2,12 @@ module TPL.Value (TPLValue(..), Env, nullEnv) where
import Data.IORef
import Data.List
+import qualified Data.Map as M
-type Env = IORef [(String, IORef TPLValue)]
+type Env = M.Map String TPLValue
nullEnv :: IO Env
-nullEnv = newIORef []
+nullEnv = newIORef $ M.null
data TPLValue = Null
| Id String
@@ -19,6 +20,7 @@ data TPLValue = Null
| Sequence [TPLValue]
| Lambda [TPLValue] TPLValue
| Function Env [TPLValue] TPLValue
+ | Env Env
| Native String deriving (Eq)
showSeq :: Show a => [a] -> String
@@ -34,11 +36,12 @@ instance Show TPLValue where
show (List vals) = show vals
show (Expression vals) = "(" ++ showSeq vals ++ ")"
show (Sequence vals) = "{\n" ++ (unlines $ map show vals) ++ "}"
- show (Native name) = "[<native> " ++ name ++ "]"
show (Function _ [] body) = "$(" ++ show body ++ ")"
show (Lambda [] body) = "$(" ++ show body ++ ")"
show (Function _ params body) = showFun params body
show (Lambda params body) = showFun params body
+ show (Native name) = "[<native> " ++ name ++ "]"
+ show (Env e) = show e
showFun :: [TPLValue] -> TPLValue -> String
showFun params body = "λ " ++ showSeq params ++ "" ++ show body

0 comments on commit 663350e

Please sign in to comment.