aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs60
1 files changed, 32 insertions, 28 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 1f99b39..f54cf7a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,55 +1,48 @@
import Data.Char
-import qualified Data.Map as M
-import System.IO
+import qualified Data.Map as M
+import System.Console.Haskeline
-import Expr as E
+import Expr as E
import Parser.Core
import Parser.Statement
main :: IO ()
-main = promptLoop (Context M.empty M.empty)
+main = runInputT defaultSettings $ promptLoop (Context M.empty M.empty)
-promptLoop :: Context -> IO ()
+promptLoop :: Context -> InputT IO ()
promptLoop context = do
- putStr "> "
- hFlush stdout
- eof <- isEOF
- if eof
- then return ()
- else do line <- getLine
- if line /= "exit"
- then loop line context >>= promptLoop
- else return ()
+ minput <- getInputLine "> "
+ case minput of
+ Nothing -> return ()
+ Just "exit" -> return ()
+ Just "env" -> putEnv context >>= promptLoop
-loop :: String -> Context -> IO Context
-loop input context =
- do
- case runParserStrict statementP (filter (not . isSpace) input) of
- Left err -> putStrLn ("Error parsing: " ++ err) >> return context
- Right s -> Main.eval s context
+ Just input -> do
+ case runParserStrict statementP (filter (not . isSpace) input) of
+ Left err -> outputStrLn ("Error parsing: " ++ err) >> promptLoop context
+ Right s -> Main.eval s context >>= promptLoop
-
-eval :: Statement -> Context -> IO Context
+eval :: Statement -> Context -> InputT IO Context
eval (Evaluation e) c = do case E.eval e c of
- Just evaluated -> putStrLn $ show evaluated
- Nothing -> putStrLn "Error: couldn't evaluate expression"
+ Just evaluated -> outputStrLn $ show evaluated
+ Nothing -> outputStrLn "Error: couldn't evaluate expression"
return c
eval (VariableDeclaration name value) (Context vars funcs) =
case E.eval value context of
- Just e -> do putStrLn $ show e
+ Just e -> do outputStrLn $ show e
return $ Context (M.insert name e vars) funcs
- Nothing -> putStrLn "Error: couldn't evaluate expression" >> return context
+ Nothing -> outputStrLn "Error: couldn't evaluate expression" >> return context
where context = Context vars funcs
eval (FunctionDeclaration name argName e) (Context vars funcs) =
-- case evalIgnore e context argName of
- -- Just e -> do putStrLn $ show e
+ -- Just e -> do outputStrLn $ show e
-- return $ Context vars (M.insert name (argName, e) funcs)
- -- Nothing -> putStrLn "Error: couldn't evaluate expression" >> return context
+ -- Nothing -> outputStrLn "Error: couldn't evaluate expression" >> return context
--
-- where context = Context vars funcs
return $ Context vars (M.insert name (argName, e) funcs)
@@ -59,3 +52,14 @@ eval _ c = return c
-- r <- eval right
+
+putEnv :: Context -> InputT IO Context
+putEnv (Context vars funcs) = do
+ outputStrLn "Variables:"
+ outputStr $ M.foldrWithKey (foldFunc fmtVariable) "" vars
+ outputStrLn "Functions:"
+ outputStr $ M.foldrWithKey (foldFunc fmtFunction) "" funcs
+ return (Context vars funcs)
+ where foldFunc fmt k v acc = acc ++ fmt k v ++ "\n"
+ fmtVariable k v = k ++ " = " ++ show v
+ fmtFunction k (arg, v) = k ++ "(" ++ arg ++ ") = " ++ show v