From 4d1a0eea5a433724764b4178d16fcb50d1c2b6bc Mon Sep 17 00:00:00 2001
From: Jan Tuomi <jans.tuomi@gmail.com>
Date: Sat, 29 Jan 2022 18:46:09 +0200
Subject: Add rudimentary step debugger

---
 samples/list.sample |  9 ++++++++-
 src/main.hs         | 21 ++++++++++++++++++++-
 2 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/samples/list.sample b/samples/list.sample
index 914522f..b3fc947 100644
--- a/samples/list.sample
+++ b/samples/list.sample
@@ -12,6 +12,13 @@ define append
     $append_val forget $append_phrase forget
     ;
 
+define stack-empty? stack-size 0 eq? ;
+
+define ..
+    [ stack-empty? not ]
+        [ . ] loop
+    ;
+
 [ 2 3 ] 1 prepend .
 [ 2 3 ] 4 append .
-[ 1 2 3 ] pop . .
\ No newline at end of file
+[ 1 2 3 ] pop ..
\ No newline at end of file
diff --git a/src/main.hs b/src/main.hs
index 551714b..5926d01 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -6,6 +6,7 @@ import Data.Map (Map, (!))
 import qualified Data.Map as M
 import Debug.Trace (trace, traceShow)
 import System.Environment (getArgs)
+import System.IO (BufferMode (NoBuffering), hSetBuffering, stdin)
 import Utils
 
 data Config = Config
@@ -64,6 +65,18 @@ debugState Config {configDebugMode = mode} state =
       putStrLn ""
     else pure ()
 
+data ExecStep = ExecContinue | ExecExit
+
+debugWaitForChar Config {configDebugMode = mode} =
+  if mode
+    then do
+      hSetBuffering stdin NoBuffering
+      c <- getChar
+      pure $ case c of
+        'q' -> ExecExit
+        _ -> ExecContinue
+    else pure ExecContinue
+
 parseWord rawStr
   | isIntStr rawStr = LInteger (read rawStr)
   | isFloatStr rawStr = LFloat $ read rawStr
@@ -78,7 +91,10 @@ interpretSource config state@LState {lSource = (word : rest)} = do
   newState <- interpretWord state {lSource = rest} word
   debugPrint config $ "processed " ++ show word ++ ", newState ="
   debugState config newState
-  interpretSource config newState
+  step <- debugWaitForChar config
+  case step of
+    ExecContinue -> interpretSource config newState
+    ExecExit -> pure ()
 
 interpretWord :: LState -> LWord -> IO LState
 -- non-nestable structures
@@ -195,6 +211,9 @@ interpretWord state@LState {lDefs = defs, lDict = dict, lSource = source, lPhras
             let (LPhrase phrase : stack') = stack
                 (first : rest) = reverse phrase
              in pure $ state {lStack = first : LPhrase (reverse rest) : stack'}
+          "stack-size" ->
+            let size = LInteger $ fromIntegral (length stack)
+             in pure $ state {lStack = size : stack}
           "']" ->
             pure $ state {lStack = LSymbol "]" : stack}
           "'[" ->
-- 
cgit v1.3