diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Environment.hs | 7 | ||||
-rw-r--r-- | src/Evaluator.hs | 14 | ||||
-rw-r--r-- | src/Parser.hs | 1 |
3 files changed, 11 insertions, 11 deletions
diff --git a/src/Environment.hs b/src/Environment.hs index 7b3f365..4c444b6 100644 --- a/src/Environment.hs +++ b/src/Environment.hs | |||
@@ -8,7 +8,8 @@ module Environment ( Env | |||
8 | , IOResult | 8 | , IOResult |
9 | ) where | 9 | ) where |
10 | 10 | ||
11 | import Control.Monad (liftM, mapM) | 11 | import Control.Applicative ((<$>)) |
12 | import Control.Monad (mapM) | ||
12 | import Control.Monad.Except | 13 | import Control.Monad.Except |
13 | import Data.IORef | 14 | import Data.IORef |
14 | import Data.Maybe (isJust) | 15 | import Data.Maybe (isJust) |
@@ -44,7 +45,7 @@ setVar :: Env -> String -> Expr -> IOResult () | |||
44 | setVar env var val = do | 45 | setVar env var val = do |
45 | ptr <- liftIO $ readIORef env | 46 | ptr <- liftIO $ readIORef env |
46 | maybe (throwError $ UnboundVariable var) | 47 | maybe (throwError $ UnboundVariable var) |
47 | (liftIO . (flip writeIORef val)) | 48 | (liftIO . flip writeIORef val) |
48 | $ lookup var ptr | 49 | $ lookup var ptr |
49 | 50 | ||
50 | defineVar :: Env -> String -> Expr -> IOResult () | 51 | defineVar :: Env -> String -> Expr -> IOResult () |
@@ -65,5 +66,5 @@ makeBind (var, val) = do | |||
65 | manyBindings :: Env -> [(String, Expr)] -> IO Env | 66 | manyBindings :: Env -> [(String, Expr)] -> IO Env |
66 | manyBindings env binds = do | 67 | manyBindings env binds = do |
67 | ptr <- readIORef env | 68 | ptr <- readIORef env |
68 | extendedEnv <- liftM (++ ptr) $ mapM makeBind binds | 69 | extendedEnv <- (++ ptr) <$> mapM makeBind binds |
69 | newIORef extendedEnv | 70 | newIORef extendedEnv |
diff --git a/src/Evaluator.hs b/src/Evaluator.hs index 1cc9edd..3d3be02 100644 --- a/src/Evaluator.hs +++ b/src/Evaluator.hs | |||
@@ -19,9 +19,9 @@ apply fn args = maybe | |||
19 | evalUnquote :: Env -> Expr -> IOResult Expr | 19 | evalUnquote :: Env -> Expr -> IOResult Expr |
20 | evalUnquote env (List [Id "unquote", vs]) = eval env vs | 20 | evalUnquote env (List [Id "unquote", vs]) = eval env vs |
21 | evalUnquote env (List [Id "quote", vs]) = | 21 | evalUnquote env (List [Id "quote", vs]) = |
22 | liftM (List . ([Id "quote"] ++ ) . (: [])) (evalUnquote env vs) | 22 | fmap (List . ([Id "quote"] ++ ) . (: [])) (evalUnquote env vs) |
23 | evalUnquote env (List vs) = liftM List $ mapM (evalUnquote env) vs | 23 | evalUnquote env (List vs) = List <$> mapM (evalUnquote env) vs |
24 | evalUnquote env (Vector vs) = liftM Vector $ mapM (evalUnquote env) vs | 24 | evalUnquote env (Vector vs) = Vector <$> mapM (evalUnquote env) vs |
25 | evalUnquote env literal = return literal | 25 | evalUnquote env literal = return literal |
26 | 26 | ||
27 | evalQuasiQuote :: Env -> Expr -> IOResult Expr | 27 | evalQuasiQuote :: Env -> Expr -> IOResult Expr |
@@ -35,12 +35,12 @@ eval _ v@(IntLiteral i) = return v | |||
35 | eval _ v@(BoolLiteral b) = return v | 35 | eval _ v@(BoolLiteral b) = return v |
36 | eval env (Id l) = getVar env l | 36 | eval env (Id l) = getVar env l |
37 | eval _ v@(FloatLiteral f) = return v | 37 | eval _ v@(FloatLiteral f) = return v |
38 | eval env v@(Vector xs) = liftM Vector $ mapM (eval env) xs | 38 | eval env v@(Vector xs) = Vector <$> mapM (eval env) xs |
39 | eval env (List[Id "quote", val]) = return val | 39 | eval env (List[Id "quote", val]) = return val |
40 | eval env (List[Id "quasiquote", val]) = evalQuasiQuote env val | 40 | eval env (List[Id "quasiquote", val]) = evalQuasiQuote env val |
41 | eval env v@(List[Id "unquote", val]) = throwError $ BadForm "Cannot use `unquote` form outside quasiquote context" v | 41 | eval env v@(List[Id "unquote", val]) = throwError $ BadForm "Cannot use `unquote` outside quasiquote form" v |
42 | eval env (List [Id "set!", Id var, val]) = eval env val >>= uncurry (*>) . ((setVar env var) &&& pure) | 42 | eval env (List [Id "set!", Id var, val]) = eval env val >>= uncurry (*>) . (setVar env var &&& pure) |
43 | eval env (List [Id "define", Id var, val]) = eval env val >>= uncurry (*>) . ((defineVar env var) &&& pure) | 43 | eval env (List [Id "define", Id var, val]) = eval env val >>= uncurry (*>) . (defineVar env var &&& pure) |
44 | eval env (List (Id fn : args)) = mapM (eval env) args >>= liftLispResult . apply fn | 44 | eval env (List (Id fn : args)) = mapM (eval env) args >>= liftLispResult . apply fn |
45 | eval env NoReturn = throwError $ BadForm "Invalid usage of non-returning expression" NoReturn | 45 | eval env NoReturn = throwError $ BadForm "Invalid usage of non-returning expression" NoReturn |
46 | 46 | ||
diff --git a/src/Parser.hs b/src/Parser.hs index a7f5571..6ec4ba0 100644 --- a/src/Parser.hs +++ b/src/Parser.hs | |||
@@ -8,7 +8,6 @@ module Parser ( parseLispValue | |||
8 | ) where | 8 | ) where |
9 | 9 | ||
10 | import Control.Applicative ((<$>)) | 10 | import Control.Applicative ((<$>)) |
11 | import Control.Monad (liftM) | ||
12 | import Text.ParserCombinators.Parsec | 11 | import Text.ParserCombinators.Parsec |
13 | 12 | ||
14 | -- TODO: use LispNumber (src/Operators.hs) here instead of IntLiteral and FloatLiteral | 13 | -- TODO: use LispNumber (src/Operators.hs) here instead of IntLiteral and FloatLiteral |