[String] -- ^ Any output from executing the statement
-- | Keep it pure!
--- Traces the execution of a program, and
-newtype Interpreter a = Interpreter { runI :: ExceptT String (WriterT [Step] (State Env)) a }
+-- The monad for tracing the execution of a program.
+-- Records a list of 'Steps' taken throughout execution
+-- Handles exceptions too.
+newtype Tracer a = Tracer { runTracer :: ExceptT String (WriterT [Step] (State Env)) a }
deriving (Functor, Applicative, Monad, MonadState Env, MonadWriter [Step], MonadError String)
-logStatement :: Statement -> Interpreter ()
+hoistEither :: Either String b -> Tracer b
+hoistEither = Tracer . ExceptT . return
+
+-- | Evaluates an expression with the current environment inside the tracer.
+evalI :: Expr -> Tracer Val
+evalI e = get >>= hoistEither . flip runEval (eval e)
+
+-- | Traces a program and returns a list of steps taken throughout its execution.
+-- Thanks to lazy evaluation though, the steps can be "streamed" and so this can
+-- be used to debug non-terminating and recursive programs!
+trace :: Statement -> [Step]
+trace x =
+ let f = runTracer (exec x)
+ (_result, effects) = fst $ flip runState mempty $ runWriterT $ runExceptT f
+ in effects
+ where
+
+ exec :: Statement -> Tracer ()
+ exec s = logStatement s >> go s
+
+ -- | Records the statement's execution in the Tracer monad
+ logStatement :: Statement -> Tracer ()
logStatement s = do
env <- get
o <- output
- Interpreter $ lift $ tell $ pure $ Step s env o
- where output :: Interpreter [String]
+ Tracer $ lift $ tell $ pure $ Step s env o
+ where output :: Tracer [String]
output
| (Print e) <- s = pure . show <$> evalI e
| otherwise = return []
-hoistEither :: Either String b -> Interpreter b
-hoistEither = Interpreter . ExceptT . return
-
--- | Evaluates an expression with the current environment inside Interpreter
-evalI :: Expr -> Interpreter Val
-evalI e = get >>= hoistEither . flip runEval (eval e)
-
--- | Executes a statement
-exec :: Statement -> Interpreter ()
-exec s = logStatement s >> go s
- where
+ -- | Where the magic happens. Provides all the control flow
+ go :: Statement -> Tracer ()
go (Assign n e) = modify . Map.insert n =<< evalI e
go (Seq s1 s2) = exec s1 >> exec s2
go (If cond sThen sElse) = do
go (Print _) = pure () -- the printing is done in 'logStatement'
go Pass = pure ()
-trace :: Statement -> [Step]
-trace f =
- let interp = runI (exec f)
- (_result, effects) = fst $ flip runState mempty $ runWriterT $ runExceptT interp
- in effects
-
-type Breakpoint = Expr
-
main :: IO ()
main = do
- hSetBuffering stdin LineBuffering -- read stuff one line at a time
+ hSetBuffering stdin LineBuffering -- Read stuff one line at a time
putStrLn "ttdb: time travelling debugger"
printMenuHelp
menu
+-- | Handles the start menu
menu :: IO ()
menu = do
cmd <- prompt
('r':' ':file) -> read <$> readFile file >>= debugProg
x -> printUnknown x >> menu
+type Breakpoint = Expr
+
debugProg :: Statement -> IO ()
debugProg prog = go (trace prog) [] [] `catch` (\e -> unless (isEOFError e) (throw e))
where
- go :: [Step] -- ^ Effects to step through
- -> [Step] -- ^ Effects that have been stepped through
+ go :: [Step] -- ^ Steps to step through
+ -> [Step] -- ^ Steps that have been stepped through
-> [Breakpoint]
-> IO ()
go [] _ _ = finishDebug
"n" -> mapM_ putStrLn output >> go xs (e:done) bps
"p" -> case done of
- [] -> return ()
+ [] -> finishDebug
(y:ys) -> go (y:list) ys bps
('e':' ':exprStr) -> do
go list done (expr:bps)
Nothing -> go list done bps
- "c" -> continue xs (e:done) bps
+ "c" -> continue xs (e:done) bps False
+ "cb" -> continue xs (e:done) bps True
"l" -> do
withColor 32 $ case bps of
_ -> printUnknown c >> go list done bps
-- | Continues until the first breakpoint is hit
- continue :: [Step] -> [Step] -> [Breakpoint] -> IO ()
- continue [] _ _ = finishDebug
- continue (e@(Step _ env output):xs) done bps = do
+ continue :: [Step] -> [Step] -> [Breakpoint] -> Bool -> IO ()
+ continue [] _ _ False = finishDebug
+ continue _ [] _ True = finishDebug
+ continue [] (x:xs) bps True = continue [x] xs bps True
+ continue list@(e@(Step _ env output):xs) done bps backwards = do
mapM_ putStrLn output
case hitBreakpoint of
Just bp -> do
withColor 32 $ putStrLn $ "Hit breakpoint: " ++ show bp
- go xs (e:done) bps
- Nothing -> continue xs (e:done) bps
+ go list done bps
+ Nothing -> if backwards
+ then continue (head done:list) (tail done) bps backwards
+ else continue xs (e:done) bps backwards
where
hitBreakpoint :: Maybe Breakpoint
hitBreakpoint = foldl f Nothing bps
putStrLn " p Previous statement"
putStrLn " e <expr> Evaluate expression"
putStrLn " c Continue to breakpoint"
+ putStrLn " cb Continue backwards to breakpoint"
putStrLn " b <expr> Set conditional breakpoint"
putStrLn " d <expr> Delete breakpoint"
putStrLn " l List breakpoints"