diff --git a/gui.rkt b/gui.rkt index 14dff48..27d3316 100644 --- a/gui.rkt +++ b/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) +(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 -> _ + ; 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])) diff --git a/interpreter.rkt b/interpreter.rkt index 28493e7..31155b2 100644 --- a/interpreter.rkt +++ b/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 -> _) ((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,