Add the ability to continue backwards
authorLuke Lau <luke_lau@icloud.com>
Sun, 25 Nov 2018 01:13:00 +0000 (01:13 +0000)
committerLuke Lau <luke_lau@icloud.com>
Sun, 25 Nov 2018 01:13:00 +0000 (01:13 +0000)
Main.hs
README.md

diff --git a/Main.hs b/Main.hs
index cbe999618300d2c9a6f762c7d9cda5b30aa1e314..ce81efbf040934b5fe250d8c21d82ff43283969f 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -85,32 +85,46 @@ data Step = Step Statement  -- ^ The statement that was executed
                  [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
@@ -125,21 +139,14 @@ exec s = logStatement s >> go s
     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
@@ -151,11 +158,13 @@ menu = do
     ('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
@@ -167,7 +176,7 @@ debugProg prog = go (trace prog) [] [] `catch` (\e -> unless (isEOFError e) (thr
         "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
@@ -187,7 +196,8 @@ debugProg prog = go (trace prog) [] [] `catch` (\e -> unless (isEOFError e) (thr
               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
@@ -210,15 +220,19 @@ debugProg prog = go (trace prog) [] [] `catch` (\e -> unless (isEOFError e) (thr
         _ -> 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
@@ -261,6 +275,7 @@ printHelp = do
   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"
index 1d53a51a5b4441c6425bf855e2e0c2cbe897743d..7c70a86f0efd71df11ce20cc0003ff852920d99a 100644 (file)
--- a/README.md
+++ b/README.md
@@ -1 +1,17 @@
-# Time Travelling Debugger
+# ttdb: Time Travelling Debugger
+
+Designed to be similar to lldb.
+
+It works by splitting up debugging into two parts:
+1. Tracing the execution of the program with `Tracer`
+2. Stepping through the traced steps
+
+By tracing the execution first, the control flow can happen in pure Haskell land
+without getting its hands dirty in IO. 
+It also has the funny effect of allowing you to see what will be evaluated
+next before the side effects are shown.
+
+## Features
+- Parses infix expressions like '3 + x' (Sub expressions require brackets)
+- Evaluate expressions when paused
+- Continue to the next breakpoint - both forwards and backwards