Implemented very basic (and ugly) stepper

gui.rkt

@@ -16,7 +16,7 @@
                [width EDITOR-WIDTH]
                [height EDITOR-HEIGHT]))
 
-; execute-content: ((ProgState) -> _) -> _
+; execute-content: (ProgState -> _) -> _
 ; Given a callback, calls the callback with the last state of execution of the
 ; program loaded in the editor
 (define (execute-content done)
@@ -26,6 +26,42 @@
      (send EDITOR get-flattened-text)))
    done on-input))
 
+; Stack of execution for stepper (List<ProgState>)
+(define step-stack '())
+
+; execute-step: (ProgState -> _) -> _
+; Given a callback, if step-stack is empty, updates step-stack as a list with
+; only the first step of execution; otherwise, it computes the next step of
+; execution, it puts it on top of step-stack, and calls the callback with that.
+(define (execute-step done)
+
+  ; after-run: Option<ProgState> -> _
+  ; Given a ProgState, it puts it in the t.o.s. of step-stack and executes done.
+  (define (after-run ps)
+    (cond [(eq? ps #f) (void)]
+          [else (set! step-stack (cons ps step-stack))
+                (done ps)]))
+  
+  (cond [(empty? step-stack)
+         (define init (program->prog-state
+                       (string->program
+                        (send EDITOR get-flattened-text))))
+         (execute-instr init after-run on-input)]
+        [(cons? step-stack)
+         (execute-instr (first step-stack) after-run on-input)]))
+
+; execute-step-back: (ProgState -> _) -> _
+; Given a callback, if step-stack is empty or of length 1, does nothing;
+; otherwise, it fetches the previous step of execution, it puts it on top of
+; step-stack (by popping and discarding the t.o.s.) and calls the callback with
+; that.
+(define (execute-step-back done)
+  (cond [(empty? step-stack) (void)]
+        [(empty? (rest step-stack)) (void)]
+        [(cons? step-stack)
+         (set! step-stack (rest step-stack))
+         (done (first step-stack))]))
+
 ; on-input: (Byte -> _) -> _
 ; Given a a callback to resume execution, sets up the run input area (callback
 ; included).
@@ -67,6 +103,19 @@
      (update-state-gui ps)
      (send RUN-OUTPUT set-field-background end-col))))
 
+; run-step: Button ControlEvent -> Nothing
+; Given the step button pressed and an event, runs the matching step (step or
+; step-back) updating the GUI.
+(define (run-step b event)
+  ; Determine matching function to run (based on the type of step)
+  (define fun-to-run (if (eqv? b STEP-BTN) execute-step execute-step-back))
+  ; run the step
+  (fun-to-run
+   (lambda (ps)
+     (print step-stack)
+     (update-state-gui ps)
+     (send RUN-OUTPUT set-field-background in-done-col))))
+
 ; update-state-gui: ProgState -> _
 ; Given a prog-state, updates the data tape inspector and the output window with
 ; the contents of that prog-state.
@@ -76,12 +125,27 @@
   (make-tape-cells ps)
   ; set output and change color to ended
   (send RUN-OUTPUT set-value out))
-  
+
+; The tape panel
+(define BUTTON-PANEL
+  (new horizontal-panel%
+       [parent F]
+       [min-height 50]
+       [stretchable-height #f]))
+
 ; Definition of the run button widget
-(define RUN-BTN (new button% [parent F]
+(define RUN-BTN (new button% [parent BUTTON-PANEL]
                      [label "Run"]
                      ; Callback procedure for a button click:
                      [callback run-program]))
+(define BSTEP-BTN (new button% [parent BUTTON-PANEL]
+                     [label "Step Back"]
+                     ; Callback procedure for a button click:
+                     [callback run-step]))
+(define STEP-BTN (new button% [parent BUTTON-PANEL]
+                     [label "Step Fwd"]
+                     ; Callback procedure for a button click:
+                     [callback run-step]))
 
 ; Definition of the editor canves
 (define C (new editor-canvas% [parent F]))

interpreter.rkt

@@ -373,10 +373,11 @@
   (lambda (done) (done 50))
   (lambda (w) (check-equal? w (prog-state (list 50) 0 1 "," "" 1 #f)))))
 
-; execute-instr: ProgState (ProgState -> _) ((Byte -> _) -> _) -> _
+; execute-instr: ProgState (Option<ProgState> -> _) ((Byte -> _) -> _) -> _
 ; Given an initial ProgState state, an async function to get input and a "done"
 ; callback, calls done with the ProgState updated after executing one
-; instruction.
+; instruction. If the program is at the last step of execution, calls done with
+; #f
 (define (execute-instr prog done get-input)
 
   ; execute-sync: Char ProgState -> ProgState
@@ -391,13 +392,15 @@
           [(char=? inst #\]) (exec-loop-end w)]
           [(char=? inst #\.) (exec-out w)]))
 
-  ; Fetch current instruction
-  (define inst (string-ref (prog-state-program prog) (prog-state-ip prog)))
+  ; Fetch current instruction. If the char is out of range, call done with #f
+  (with-handlers
+      ([exn:fail:contract? (lambda (e) (done #f))])
+    (define inst (string-ref (prog-state-program prog) (prog-state-ip prog)))
 
-  ; Execute asynchr. if ",", otherwise call callback with results of
-  ; execute-sync
-  (cond [(char=? inst #\,) (exec-in prog get-input done)]
-        [else (done (execute-sync inst prog))]))
+    ; Execute asynchr. if ",", otherwise call callback with results of
+    ; execute-sync
+    (cond [(char=? inst #\,) (exec-in prog get-input done)]
+          [else (done (execute-sync inst prog))])))
 
 ; execute: ProgState (ProgState -> _) ((Byte -> _) -> _) -> _
 ; Given an initial ProgState state,