Skip to content

Commit 17f6c64

Browse files
asarhaddonasarhaddon
committed
haskell: cosmetic improvements in step files
Simplify mal/try* with haskell/catchError. Merge rep into repl_loop for readability. Only load readline history in interactive mode.
1 parent af8a431 commit 17f6c64

File tree

11 files changed

+104
-153
lines changed

11 files changed

+104
-153
lines changed

‎impls/haskell/step0_repl.hs‎

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -19,9 +19,6 @@ mal_print = id
1919

2020
-- repl
2121

22-
rep :: String -> String
23-
rep = mal_print . eval . mal_read
24-
2522
repl_loop :: IO ()
2623
repl_loop = do
2724
line <- readline "user> "
@@ -30,11 +27,11 @@ repl_loop = do
3027
Just "" -> repl_loop
3128
Just str -> do
3229
addHistory str
33-
putStrLn $ rep str
30+
let out = mal_print $ eval $ mal_read str
31+
putStrLn out
3432
repl_loop
3533

3634
main :: IO ()
3735
main = do
3836
load_history
39-
4037
repl_loop

‎impls/haskell/step1_read_print.hs‎

Lines changed: 6 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
import Control.Monad.Except (liftIO, runExceptT)
1+
import Control.Monad.Except (runExceptT)
22

33
import Readline (addHistory, readline, load_history)
44
import Types
@@ -17,14 +17,11 @@ eval = id
1717

1818
-- print
1919

20-
mal_print :: MalVal -> IOThrows String
21-
mal_print = liftIO . Printer._pr_str True
20+
mal_print :: MalVal -> IO String
21+
mal_print = _pr_str True
2222

2323
-- repl
2424

25-
rep :: String -> IOThrows String
26-
rep line = mal_print =<< (eval <$> mal_read line)
27-
2825
repl_loop :: IO ()
2926
repl_loop = do
3027
line <- readline "user> "
@@ -33,15 +30,14 @@ repl_loop = do
3330
Just "" -> repl_loop
3431
Just str -> do
3532
addHistory str
36-
res <- runExceptT $ rep str
33+
res <- runExceptT $ eval <$> mal_read str
3734
out <- case res of
38-
Left mv -> (++) "Error: " <$> liftIO (Printer._pr_str True mv)
39-
Right val -> return val
35+
Left mv -> (++) "Error: " <$> mal_print mv
36+
Right val -> mal_print val
4037
putStrLn out
4138
repl_loop
4239

4340
main :: IO ()
4441
main = do
4542
load_history
46-
4743
repl_loop

‎impls/haskell/step2_eval.hs‎

Lines changed: 31 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,12 @@
11
import Control.Monad.Except (liftIO, runExceptT)
2-
import qualified Data.Map as Map
2+
import qualified Data.Map.Strict as Map
33

44
import Readline (addHistory, readline, load_history)
55
import Types
66
import Reader (read_str)
7-
import Printer (_pr_list, _pr_str)
7+
import Printer(_pr_list, _pr_str)
88

9-
--
10-
-- Set this to True for a trace of each call to Eval.
11-
--
12-
traceEval :: Bool
13-
traceEval = False
9+
type Env = Map.Map String MalVal
1410

1511
-- read
1612

@@ -19,34 +15,32 @@ mal_read = read_str
1915

2016
-- eval
2117

22-
apply_ast :: MalVal -> [MalVal] -> IOThrows MalVal
23-
apply_ast first rest = do
24-
evd <- eval first
18+
apply_ast :: MalVal -> [MalVal] -> Env -> IOThrows MalVal
19+
apply_ast first rest env = do
20+
evd <- eval env first
2521
case evd of
26-
MalFunction _ f -> f =<< mapM eval rest
22+
MalFunction _ f -> f =<< mapM (eval env) rest
2723
_ -> throwStr . (++) "invalid apply: " =<< liftIO (_pr_list True " " $ first : rest)
2824

29-
eval :: MalVal -> IOThrows MalVal
30-
eval ast = do
31-
case traceEval of
32-
True -> liftIO $ do
33-
putStr "EVAL: "
34-
putStrLn =<< _pr_str True ast
35-
False -> pure ()
25+
eval :: Env -> MalVal -> IOThrows MalVal
26+
eval env ast = do
27+
-- putStr "EVAL: "
28+
-- putStrLn =<< mal_print ast
3629
case ast of
3730
MalSymbol sym -> do
38-
case Map.lookup sym repl_env of
31+
let maybeVal = Map.lookup sym env
32+
case maybeVal of
3933
Nothing -> throwStr $ "'" ++ sym ++ "' not found"
4034
Just val -> return val
41-
MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as
42-
MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM eval xs
43-
MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM eval xs
35+
MalSeq _ (Vect False) (a1 : as) -> apply_ast a1 as env
36+
MalSeq _ (Vect True) xs -> MalSeq (MetaData Nil) (Vect True) <$> mapM (eval env) xs
37+
MalHashMap _ xs -> MalHashMap (MetaData Nil) <$> mapM (eval env) xs
4438
_ -> return ast
4539

4640
-- print
4741

48-
mal_print :: MalVal -> IOThrows String
49-
mal_print = liftIO . Printer._pr_str True
42+
mal_print :: MalVal -> IO String
43+
mal_print = _pr_str True
5044

5145
-- repl
5246

@@ -66,35 +60,27 @@ divd :: Fn
6660
divd [MalNumber a, MalNumber b] = return $ MalNumber $ a `div` b
6761
divd _ = throwStr $ "illegal arguments to /"
6862

69-
repl_env :: Map.Map String MalVal
70-
repl_env = Map.fromList [("+", _func add),
71-
("-", _func sub),
72-
("*", _func mult),
73-
("/", _func divd)]
74-
75-
rep :: String -> IOThrows String
76-
rep line = mal_print =<< eval =<< mal_read line
77-
78-
repl_loop :: IO ()
79-
repl_loop = do
63+
repl_loop :: Env -> IO ()
64+
repl_loop env = do
8065
line <- readline "user> "
8166
case line of
8267
Nothing -> return ()
83-
Just "" -> repl_loop
68+
Just "" -> repl_loop env
8469
Just str -> do
8570
addHistory str
86-
res <- runExceptT $ rep str
71+
res <- runExceptT $ eval env =<< mal_read str
8772
out <- case res of
88-
Left mv -> (++) "Error: " <$> liftIO (Printer._pr_str True mv)
89-
Right val -> return val
73+
Left mv -> (++) "Error: " <$> mal_print mv
74+
Right val -> mal_print val
9075
putStrLn out
91-
repl_loop
92-
93-
_func :: Fn -> MalVal
94-
_func f = MalFunction (MetaData Nil) f
76+
repl_loop env
9577

9678
main :: IO ()
9779
main = do
98-
load_history
80+
let repl_env = Map.fromList [("+", MalFunction (MetaData Nil) add),
81+
("-", MalFunction (MetaData Nil) sub),
82+
("*", MalFunction (MetaData Nil) mult),
83+
("/", MalFunction (MetaData Nil) divd)]
9984

100-
repl_loop
85+
load_history
86+
repl_loop repl_env

‎impls/haskell/step3_env.hs‎

Lines changed: 6 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -66,8 +66,8 @@ eval env ast = do
6666

6767
-- print
6868

69-
mal_print :: MalVal -> IOThrows String
70-
mal_print = liftIO . Printer._pr_str True
69+
mal_print :: MalVal -> IO String
70+
mal_print = _pr_str True
7171

7272
-- repl
7373

@@ -87,9 +87,6 @@ divd :: Fn
8787
divd [MalNumber a, MalNumber b] = return $ MalNumber $ a `div` b
8888
divd _ = throwStr $ "illegal arguments to /"
8989

90-
rep :: Env -> String -> IOThrows String
91-
rep env line = mal_print =<< eval env =<< mal_read line
92-
9390
repl_loop :: Env -> IO ()
9491
repl_loop env = do
9592
line <- readline "user> "
@@ -98,10 +95,10 @@ repl_loop env = do
9895
Just "" -> repl_loop env
9996
Just str -> do
10097
addHistory str
101-
res <- runExceptT $ rep env str
98+
res <- runExceptT $ eval env =<< mal_read str
10299
out <- case res of
103-
Left mv -> (++) "Error: " <$> liftIO (Printer._pr_str True mv)
104-
Right val -> return val
100+
Left mv -> (++) "Error: " <$> mal_print mv
101+
Right val -> mal_print val
105102
putStrLn out
106103
repl_loop env
107104

@@ -111,13 +108,12 @@ defBuiltIn env sym f =
111108

112109
main :: IO ()
113110
main = do
114-
load_history
115-
116111
repl_env <- env_new Nothing
117112

118113
defBuiltIn repl_env "+" add
119114
defBuiltIn repl_env "-" sub
120115
defBuiltIn repl_env "*" mult
121116
defBuiltIn repl_env "/" divd
122117

118+
load_history
123119
repl_loop repl_env

‎impls/haskell/step4_if_fn_do.hs‎

Lines changed: 6 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -100,14 +100,11 @@ eval env ast = do
100100

101101
-- print
102102

103-
mal_print :: MalVal -> IOThrows String
104-
mal_print = liftIO . Printer._pr_str True
103+
mal_print :: MalVal -> IO String
104+
mal_print = _pr_str True
105105

106106
-- repl
107107

108-
rep :: Env -> String -> IOThrows String
109-
rep env line = mal_print =<< eval env =<< mal_read line
110-
111108
repl_loop :: Env -> IO ()
112109
repl_loop env = do
113110
line <- readline "user> "
@@ -116,10 +113,10 @@ repl_loop env = do
116113
Just "" -> repl_loop env
117114
Just str -> do
118115
addHistory str
119-
res <- runExceptT $ rep env str
116+
res <- runExceptT $ eval env =<< mal_read str
120117
out <- case res of
121-
Left mv -> (++) "Error: " <$> liftIO (Printer._pr_str True mv)
122-
Right val -> return val
118+
Left mv -> (++) "Error: " <$> mal_print mv
119+
Right val -> mal_print val
123120
putStrLn out
124121
repl_loop env
125122

@@ -139,8 +136,6 @@ defBuiltIn env (sym, f) =
139136

140137
main :: IO ()
141138
main = do
142-
load_history
143-
144139
repl_env <- env_new Nothing
145140

146141
-- core.hs: defined using Haskell
@@ -149,4 +144,5 @@ main = do
149144
-- core.mal: defined using the language itself
150145
re repl_env "(def! not (fn* (a) (if a false true)))"
151146

147+
load_history
152148
repl_loop repl_env

‎impls/haskell/step5_tco.hs‎

Lines changed: 6 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -100,14 +100,11 @@ eval env ast = do
100100

101101
-- print
102102

103-
mal_print :: MalVal -> IOThrows String
104-
mal_print = liftIO . Printer._pr_str True
103+
mal_print :: MalVal -> IO String
104+
mal_print = _pr_str True
105105

106106
-- repl
107107

108-
rep :: Env -> String -> IOThrows String
109-
rep env line = mal_print =<< eval env =<< mal_read line
110-
111108
repl_loop :: Env -> IO ()
112109
repl_loop env = do
113110
line <- readline "user> "
@@ -116,10 +113,10 @@ repl_loop env = do
116113
Just "" -> repl_loop env
117114
Just str -> do
118115
addHistory str
119-
res <- runExceptT $ rep env str
116+
res <- runExceptT $ eval env =<< mal_read str
120117
out <- case res of
121-
Left mv -> (++) "Error: " <$> liftIO (Printer._pr_str True mv)
122-
Right val -> return val
118+
Left mv -> (++) "Error: " <$> mal_print mv
119+
Right val -> mal_print val
123120
putStrLn out
124121
repl_loop env
125122

@@ -139,8 +136,6 @@ defBuiltIn env (sym, f) =
139136

140137
main :: IO ()
141138
main = do
142-
load_history
143-
144139
repl_env <- env_new Nothing
145140

146141
-- core.hs: defined using Haskell
@@ -149,4 +144,5 @@ main = do
149144
-- core.mal: defined using the language itself
150145
re repl_env "(def! not (fn* (a) (if a false true)))"
151146

147+
load_history
152148
repl_loop repl_env

‎impls/haskell/step6_file.hs‎

Lines changed: 7 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -101,14 +101,11 @@ eval env ast = do
101101

102102
-- print
103103

104-
mal_print :: MalVal -> IOThrows String
105-
mal_print = liftIO . Printer._pr_str True
104+
mal_print :: MalVal -> IO String
105+
mal_print = _pr_str True
106106

107107
-- repl
108108

109-
rep :: Env -> String -> IOThrows String
110-
rep env line = mal_print =<< eval env =<< mal_read line
111-
112109
repl_loop :: Env -> IO ()
113110
repl_loop env = do
114111
line <- readline "user> "
@@ -117,10 +114,10 @@ repl_loop env = do
117114
Just "" -> repl_loop env
118115
Just str -> do
119116
addHistory str
120-
res <- runExceptT $ rep env str
117+
res <- runExceptT $ eval env =<< mal_read str
121118
out <- case res of
122-
Left mv -> (++) "Error: " <$> liftIO (Printer._pr_str True mv)
123-
Right val -> return val
119+
Left mv -> (++) "Error: " <$> mal_print mv
120+
Right val -> mal_print val
124121
putStrLn out
125122
repl_loop env
126123

@@ -145,7 +142,6 @@ evalFn _ _ = throwStr "illegal call of eval"
145142
main :: IO ()
146143
main = do
147144
args <- getArgs
148-
load_history
149145

150146
repl_env <- env_new Nothing
151147

@@ -163,4 +159,6 @@ main = do
163159
re repl_env $ "(load-file \"" ++ script ++ "\")"
164160
[] -> do
165161
env_set repl_env "*ARGV*" $ toList []
162+
163+
load_history
166164
repl_loop repl_env

0 commit comments

Comments
 (0)