diff options
author | Akshay <[email protected]> | 2020-10-17 04:57:40 +0100 |
---|---|---|
committer | Akshay <[email protected]> | 2020-10-17 04:57:40 +0100 |
commit | 032e26cf9ed236889637e02e56aef7c22721cd23 (patch) | |
tree | 6a9ae58d7c5a661249d400eb281c7a2c44263eaf | |
parent | 297b498acd205f0fcd68f3cdf7536b480cfac5e3 (diff) |
prefer applicative over monadic style
-rw-r--r-- | bin/Main.hs | 13 | ||||
-rw-r--r-- | shell.nix | 1 | ||||
-rw-r--r-- | src/Environment.hs | 7 | ||||
-rw-r--r-- | src/Evaluator.hs | 14 | ||||
-rw-r--r-- | src/Parser.hs | 1 |
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 | ||
21 | evalExpr :: Env -> String -> IO (LispResult String) | 21 | evalExpr :: Env -> String -> IO (LispResult String) |
22 | evalExpr env inp = runExceptT $ fmap show $ | 22 | evalExpr env inp = runExceptT $ fmap show $ |
23 | (liftLispResult $ readExpr inp) >>= eval env | 23 | liftLispResult (readExpr inp) >>= eval env |
24 | 24 | ||
25 | repl :: Env -> IO () | 25 | repl :: Env -> IO () |
26 | repl env = do | 26 | repl 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 | ||
38 | main :: IO () | 35 | main :: IO () |
39 | main = do | 36 | main = 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 |
@@ -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 | ]; |
37 | in | 38 | in |
38 | pkgs.stdenv.mkDerivation { | 39 | pkgs.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 | ||
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 |