Skip to content

Instantly share code, notes, and snippets.

@dimidd
Last active June 20, 2016 19:46
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save dimidd/452c772371ad131055a49cd67957f201 to your computer and use it in GitHub Desktop.
Save dimidd/452c772371ad131055a49cd67957f201 to your computer and use it in GitHub Desktop.
module Main where
import Syntax
import Parser
import Eval
import Pretty
import Counter
import Control.Monad
import Control.Monad.Trans
import System.Console.Haskeline
import Control.Monad.State
import Control.Monad.Identity
showStep :: (Int, Expr) -> IO ()
showStep (d, x) = putStrLn ((replicate d ' ') ++ "=> " ++ ppexpr x)
process :: Counter -> String -> IO ()
process c line =
if ((length line) > 0)
then
if (head line) /= '%'
then do
let res = parseExpr line
case res of
Left err -> print err
Right ex -> do
let (out, ~steps) = runEval ex
mapM_ showStep steps
out_ps1 c $ show out
else do
let out = handle_cmd line
out_ps1 c $ show out
-- TODO: don't increment counter for empty lines
else do
putStrLn ""
out_ps1 :: Counter -> String -> IO ()
out_ps1 c out = do
let out_count_io = c 0
out_count <- out_count_io
putStrLn $ "Out[" ++ (show out_count) ++ "]: " ++ out
putStrLn ""
handle_cmd :: String -> String
handle_cmd line = if line == "%hist"
then
"hist stub"
else
"unknown cmd"
main :: IO [String]
main = do
c <- makeCounter
execStateT (repl c) []
repl :: Counter -> StateT [String] IO ()
repl c = lift $ runInputT defaultSettings loop
where
loop = do
minput <- getLineIO $ in_ps1 $ c
case minput of
Nothing -> lift $ outputStrLn "Goodbye."
Just input -> (liftIO $ process c input) >> loop
getLineIO :: (MonadException m) => IO String -> InputT m (Maybe String)
getLineIO ios = do
s <- liftIO ios
getInputLine s
in_ps1 :: Counter -> IO String
in_ps1 c = do
let ion = c 1
n <- ion
let s = "Untyped In[" ++ (show n) ++ "]> "
return s
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment