aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAkshay <[email protected]>2020-10-17 04:57:40 +0100
committerAkshay <[email protected]>2020-10-17 04:57:40 +0100
commit032e26cf9ed236889637e02e56aef7c22721cd23 (patch)
tree6a9ae58d7c5a661249d400eb281c7a2c44263eaf
parent297b498acd205f0fcd68f3cdf7536b480cfac5e3 (diff)
prefer applicative over monadic style
-rw-r--r--bin/Main.hs13
-rw-r--r--shell.nix1
-rw-r--r--src/Environment.hs7
-rw-r--r--src/Evaluator.hs14
-rw-r--r--src/Parser.hs1
5 files changed, 17 insertions, 19 deletions
diff --git a/bin/Main.hs b/bin/Main.hs
index c66d328..18e1c53 100644
--- a/bin/Main.hs
+++ b/bin/Main.hs
@@ -20,7 +20,7 @@ readExpr inp =
20 20
21evalExpr :: Env -> String -> IO (LispResult String) 21evalExpr :: Env -> String -> IO (LispResult String)
22evalExpr env inp = runExceptT $ fmap show $ 22evalExpr env inp = runExceptT $ fmap show $
23 (liftLispResult $ readExpr inp) >>= eval env 23 liftLispResult (readExpr inp) >>= eval env
24 24
25repl :: Env -> IO () 25repl :: Env -> IO ()
26repl env = do 26repl env = do
@@ -29,20 +29,17 @@ repl env = do
29 case inp of 29 case inp of
30 Nothing -> return () 30 Nothing -> return ()
31 Just ",q" -> return () 31 Just ",q" -> return ()
32 Just i -> do 32 Just i -> evalExpr env i >>= either (putStrLn . pp i) putStrLn >> repl env
33 out <- evalExpr env i
34 either (putStrLn . pp i) putStrLn out
35 repl env
36 33
37 34
38main :: IO () 35main :: IO ()
39main = do 36main = do
40 args <- getArgs 37 args <- getArgs
41 initEnv <- newEnv 38 env <- newEnv
42 if null args 39 if null args
43 then do 40 then do
44 putStrLn ";;; Entering lisk repl ..." 41 putStrLn ";;; Entering lisk repl ..."
45 repl initEnv 42 repl env
46 else do 43 else do
47 let pp = showError defaults "(lisk-repl)" 44 let pp = showError defaults "(lisk-repl)"
48 evalExpr initEnv (head args) >>= (either (putStrLn . pp) print) 45 evalExpr env (head args) >>= either (putStrLn . pp) print
diff --git a/shell.nix b/shell.nix
index 15334f5..0f07252 100644
--- a/shell.nix
+++ b/shell.nix
@@ -33,6 +33,7 @@ let
33 pkgs.cabal2nix 33 pkgs.cabal2nix
34 haskellPackages.cabal-install 34 haskellPackages.cabal-install
35 haskellPackages.hoogle 35 haskellPackages.hoogle
36 haskellPackages.hlint
36 ]; 37 ];
37in 38in
38pkgs.stdenv.mkDerivation { 39pkgs.stdenv.mkDerivation {
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
11import Control.Monad (liftM, mapM) 11import Control.Applicative ((<$>))
12import Control.Monad (mapM)
12import Control.Monad.Except 13import Control.Monad.Except
13import Data.IORef 14import Data.IORef
14import Data.Maybe (isJust) 15import Data.Maybe (isJust)
@@ -44,7 +45,7 @@ setVar :: Env -> String -> Expr -> IOResult ()
44setVar env var val = do 45setVar 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
50defineVar :: Env -> String -> Expr -> IOResult () 51defineVar :: Env -> String -> Expr -> IOResult ()
@@ -65,5 +66,5 @@ makeBind (var, val) = do
65manyBindings :: Env -> [(String, Expr)] -> IO Env 66manyBindings :: Env -> [(String, Expr)] -> IO Env
66manyBindings env binds = do 67manyBindings 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
19evalUnquote :: Env -> Expr -> IOResult Expr 19evalUnquote :: Env -> Expr -> IOResult Expr
20evalUnquote env (List [Id "unquote", vs]) = eval env vs 20evalUnquote env (List [Id "unquote", vs]) = eval env vs
21evalUnquote env (List [Id "quote", vs]) = 21evalUnquote env (List [Id "quote", vs]) =
22 liftM (List . ([Id "quote"] ++ ) . (: [])) (evalUnquote env vs) 22 fmap (List . ([Id "quote"] ++ ) . (: [])) (evalUnquote env vs)
23evalUnquote env (List vs) = liftM List $ mapM (evalUnquote env) vs 23evalUnquote env (List vs) = List <$> mapM (evalUnquote env) vs
24evalUnquote env (Vector vs) = liftM Vector $ mapM (evalUnquote env) vs 24evalUnquote env (Vector vs) = Vector <$> mapM (evalUnquote env) vs
25evalUnquote env literal = return literal 25evalUnquote env literal = return literal
26 26
27evalQuasiQuote :: Env -> Expr -> IOResult Expr 27evalQuasiQuote :: Env -> Expr -> IOResult Expr
@@ -35,12 +35,12 @@ eval _ v@(IntLiteral i) = return v
35eval _ v@(BoolLiteral b) = return v 35eval _ v@(BoolLiteral b) = return v
36eval env (Id l) = getVar env l 36eval env (Id l) = getVar env l
37eval _ v@(FloatLiteral f) = return v 37eval _ v@(FloatLiteral f) = return v
38eval env v@(Vector xs) = liftM Vector $ mapM (eval env) xs 38eval env v@(Vector xs) = Vector <$> mapM (eval env) xs
39eval env (List[Id "quote", val]) = return val 39eval env (List[Id "quote", val]) = return val
40eval env (List[Id "quasiquote", val]) = evalQuasiQuote env val 40eval env (List[Id "quasiquote", val]) = evalQuasiQuote env val
41eval env v@(List[Id "unquote", val]) = throwError $ BadForm "Cannot use `unquote` form outside quasiquote context" v 41eval env v@(List[Id "unquote", val]) = throwError $ BadForm "Cannot use `unquote` outside quasiquote form" v
42eval env (List [Id "set!", Id var, val]) = eval env val >>= uncurry (*>) . ((setVar env var) &&& pure) 42eval env (List [Id "set!", Id var, val]) = eval env val >>= uncurry (*>) . (setVar env var &&& pure)
43eval env (List [Id "define", Id var, val]) = eval env val >>= uncurry (*>) . ((defineVar env var) &&& pure) 43eval env (List [Id "define", Id var, val]) = eval env val >>= uncurry (*>) . (defineVar env var &&& pure)
44eval env (List (Id fn : args)) = mapM (eval env) args >>= liftLispResult . apply fn 44eval env (List (Id fn : args)) = mapM (eval env) args >>= liftLispResult . apply fn
45eval env NoReturn = throwError $ BadForm "Invalid usage of non-returning expression" NoReturn 45eval 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
10import Control.Applicative ((<$>)) 10import Control.Applicative ((<$>))
11import Control.Monad (liftM)
12import Text.ParserCombinators.Parsec 11import 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